Datenübertrag in geschützes Sheet scheitert
09.05.2016 13:36:52
Dietmar
nach längerer Zeit habe ich mal wieder ein Nuss zu knacken. Tüftele bereits seit längerer Zeit erfolglos ein folgendem Codeschnipsel herum, da der Befehl für einen Datenübertrag auf einmal nicht mehr funktioniert.
Den Code hatte ich vor ein paar Jahren hier im Forum mal von Sepp erhalten; seither lief alles bestens. Der Code öffnet aus einer Exceldatei heraus per Makro den Dateiexplorer; dort wird dann die Datei ausgewählt und DANN sollte der ÜbertragungsCode ablaufen. Der Code scheitert zur Zeit aber schon beim Aufruf der ausgewählten Zieldatei (WENN diese einen Blattschutz hat; der muss aber erhalten bleiben).
Das Problem betrifft auch nicht alle Anwender, sondern merkwürdigerweise nur Excel-User, die Windows 10 verwenden, wiewohl ich mir keinen Reim daraus machen kann.
Aus Kompatibilitätsgründen wird das .xls-Dateiformat verwendet.
Muss ggf. in der Deklaration etwas geändert oder angepasst werden oder sollte ich das mir bekannte PW beim Aufruf hinterlegen (wiewohl das bisher nicht nötig war)?
'Datei aufrufen und Datenübertrag starten ...
Dim strFile As String, strNewName As String
Dim objWB As Workbook, objWS As Worksheet, objTarget As Worksheet
Dim Rng As Range, rngF As Range, rngc As Range
Dim blnOpen As Boolean
Dim lngRow As Long, lngLast As Long, lngN As Long
Dim varResult As Variant
On Error GoTo ErrExit
GMS
ChDrive "C"
ChDir "C:\Testordner\01-Testunterordner"
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm")
If strFile = "Falsch" Or strFile = ThisWorkbook.FullName Then GoTo ErrExit
(!) ab hier springt der Befehl zu 'ErrExit' und bricht dann natürlcih ab. Aber nur, wenn die _
Datei einen Blattschutz hat (!)
blnOpen = IsOpen(strFile)
If blnOpen Then
Set objWB = Workbooks(Mid(strFile, InStrRev(strFile, "\") + 1))
Else
Set objWB = Workbooks.Open(strFile)
End If
Set objTarget = objWB.Sheets(1) 'Tabelle 1 aktivieren, egal wie sie heißt
Viele Grüße
Dietmar aus Aachen