Geacht forum,
Onderstaande code werkt perfect, is onderdeel van een andere code (via Call data_overzetten) deze opent het doel bestand en kopieert de gegevens en sluit netjes af,
Nu komt het voor dat als het doel bestand is geopend de code (wordt ge)stopt, en de gegevens niet worden gekopieerd, (bron document wordt wel opgeslagen en mail wordt verstuurt. onderdeel van de overkoepelde code)
ik zou graag een msgbox laten zien als het bronbestand is geopend dat men "document later opnieuw opent en dan de data overzet." en deze code wordt onderbroken " exit sub
weet niet goed hoe de code eruit moet zien als de bron is geopend voor "With GetObject(.."
gr
Henny
Onderstaande code werkt perfect, is onderdeel van een andere code (via Call data_overzetten) deze opent het doel bestand en kopieert de gegevens en sluit netjes af,
Nu komt het voor dat als het doel bestand is geopend de code (wordt ge)stopt, en de gegevens niet worden gekopieerd, (bron document wordt wel opgeslagen en mail wordt verstuurt. onderdeel van de overkoepelde code)
ik zou graag een msgbox laten zien als het bronbestand is geopend dat men "document later opnieuw opent en dan de data overzet." en deze code wordt onderbroken " exit sub
weet niet goed hoe de code eruit moet zien als de bron is geopend voor "With GetObject(.."
Code:
Sub DATA_Overzetten()
'data overzetten naar klachtenoverzicht, overzicht opslaan en sluiten
Dim ar
Dim r
With Sheets("DATA overzetten")
ar = Array(.Range("Datum").Value, .Range("Document").Value, .Range("Debiteurnr").Value, .Range("Klant").Value, .Range("Artikelnr").Value, .Range("Product").Value, .Range("Klacht").Value, .Range("KLachtCAT").Value, .Range("Coördinator").Value, .Range("Filter1").Value, .Range("Filter2").Value, .Range("Filter3").Value, .Range("Rayon").Value, .Range("Profit").Value, .Range("Contact").Value, .Range("PRodsite").Value, .Range("CoördinatorSite").Value, .Range("Class").Value, .Range("Veroorzaakafd").Value)
End With
With GetObject("S:\Projecten\Klachten\Nieuwe Klachten procedure 2020\Klachtenoverzicht test.xlsm").Sheets("Klachten overzicht")
r = Application.Match(ar(1), .Columns(4), 0)
If IsNumeric(r) Then .Cells(r, 3).Resize(, 19) = ar Else .Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(, 19) = ar
.Parent.Close True
End With
End Sub
gr
Henny