Probleme beim Öffnen mit Passwort

Hallo Forum,
ich habe mir eine Anwendung gebastelt, um in allen verfügbaren Mappen nach bestimmten Daten zu suchen. Grundsätzlich funktioniert mein Code. Probleme habe ich mit Mappen, welche durch ein Kennwort geschützt sind. Zwar wird beim Öffnen der Mappe ein Kennwort angefordert, doch wenn ein flasches Kennwort eingegeben wird, oder die Eingabe abgebrochen wird, habe ich Probleme mit meinem Code. Allerdings nicht beim ersten Versuch, sondern erst dann, wenn nochmals eine Mappe mit einem Kennwort geöfffnet werden soll.
Ich habe eine kleine Testanwendung erstellt und hochgeladen. Mit ihr wird zuerst eine Mappe mit Kennwort, dann eine ohne Kennwort, und dann wieder eine mit Kennwort eröffnet. Während beim Versuch 1 die "on Error"-Routine funktioniert, versagt sie beim Öffnen der 3. Mappe.
https://www.herber.de/bbs/user/145840.zip
Wenn ich eine weitere Mappe mit Passwort öfffne, und dass Passwort nicht richtig eingebe, oder auf "Abbrechen klicke", erhalte ich einen Laufzeitfehler 1004. Gebe ich beim Öffnen der 1. Mappe das richtige Passwort ein, funktioniert auch meine On-Error-Routine bei der 3. Mappe.
Kann mit jemand sagen, warum?
Grundsätzlich möchte ich nicht alle Mappen mit Kennwort ausschließen, deshalb habe ich darauf verzichtet, diesen Status abzufragen.
Ubrigens: dass Kennwort lauetet: Passwort
Gruß Werner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ProblemebeimOpen() Dim wb(1 To 3) As Workbook, wb2 As Workbook Dim Openfail As Boolean Dim Loop1 As Integer Dim FullName As String Dim Mappen(1 To 3, 1 To 2) As Variant, sInfo As String Mappen(1, 1) = ActiveWorkbook.Path & "\" & "Mappe 1 - mit Passwort.xlsm" Mappen(1, 2) = 4711 Mappen(2, 1) = ActiveWorkbook.Path & "\" & "Mappe 2 - ohne Passwort.xlsm" Mappen(2, 2) = Empty Mappen(3, 1) = ActiveWorkbook.Path & "\" & "Mappe 3 - mit Passwort.xlsm" Mappen(3, 2) = "4711" Application.DisplayAlerts = False For Loop1 = 1 To UBound(Mappen) FullName = Mappen(Loop1, 1) On Error Resume Next If Mappen(Loop1, 2) = Empty Then Set wb(Loop1) = Workbooks.Open(Filename:=FullName, Local:=True) ', Password:=4711) Else Set wb(Loop1) = Workbooks.Open(Filename:=FullName, Local:=True, Password:="4711") End If If wb(Loop1) Is Nothing Then sInfo = sInfo & Mappen(Loop1, 1) & vbCrLf End If On Error GoTo 0 Next Loop1 If Len(sInfo) > 0 Then MsgBox "folgende Arbeitsmappe(n) konnte(n) nicht geladen werden:" & vbCrLf & sInfo, _ 16 + vbMsgBoxSetForeground, "Programmende!" For Loop1 = 1 To UBound(wb) If Not (wb(Loop1) Is Nothing) Then wb(Loop1).Close , False Set wb(Loop1) = Nothing End If Next Loop1 Erase Mappen Erase wb Exit Sub End If ''hier gehtt'sa weiter, wenn alle Arbeitsmappen geöffnet werden konnten ''mit Deinem Vba-Code End Sub

If Mappen(Loop1, 2) = Empty Then Set wb(Loop1) = Workbooks.Open(Filename:=FullName, Local:=True) ', Password:=4711) Else Set wb(Loop1) = Workbooks.Open(Filename:=FullName, Local:=True, Password:=Mappen(Loop1, 2)) End If

Hallo Werner,
ich hatte mich auch mit deinem Problem beschäftigt.
Wenn du mehr Fehler-Informationen haben willst, dann musst du die Fehlerbehandlung anders aufbauen.
Soweit ich festgestellt habe, hat der Fehler immer die Nummer 1004, aber mit unterschiedlichen Beschreibungen.
Musst du halt mal schauen, wie du meinen Code in dein neues Makro integrierst.
LG
Franz


Sub ProblemebeimOpen()
Dim Loop1 As Integer
Dim FullName As String
Dim Mappen(1 To 3) As Variant
Dim wkb As Workbook
Dim strInfo As String
On Error GoTo OpenFailed
Mappen(1) = ActiveWorkbook.Path & "\" & "Mappe 1 - mit Passwort.xlsm"
Mappen(2) = ActiveWorkbook.Path & "\" & "Mappe 2 - ohne Passwort.xlsm"
Mappen(3) = ActiveWorkbook.Path & "\" & "Mappe 3 - mit Passwort.xlsm"
For Loop1 = 1 To UBound(Mappen)
FullName = Mappen(Loop1)
Application.DisplayAlerts = False
Debug.Print "vor Open " & FullName
Set wkb = Workbooks.Open(Filename:=FullName, Local:=True) ', Password:=4711
Debug.Print "WorkBook geöffnet: " & FullName
Application.Wait Now + TimeSerial(0, 0, 2) '2 Sekunden warten - zum Testen
wkb.Close savechanges:=False
ResumeNextLoop:
Application.DisplayAlerts = True
Next Loop1
If strInfo  "" Then
MsgBox "Probleme bei folgenden Dateien:" & strInfo, vbInformation + vbOKOnly, "Fehler-Info - ProblemebeimOpen"
End If
OpenFailed:
With Err
Select Case .Number
Case 0 'alles in Ordnug
Case 1004
Debug.Print "Open gescheitert"
strInfo = strInfo & vbLf & Replace(FullName, ActiveWorkbook.Path & "\", "") & vbLf & "     "
If InStr(.Description, "Kennwort ist ungültig") > 0 Then
strInfo = strInfo & "falsches Kennwort eingegeben"
ElseIf InStr(.Description, "'Open' für das Objekt") Then
strInfo = strInfo & "Kennwort-Eingabe abgebrochen"
Else
strInfo = strInfo & .Description
End If
Resume ResumeNextLoop
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Probleme beim Öffnen mit Passwort

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Probleme beim Öffnen mit Passwort

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread