Ordner durchsuchen mit Ausnahme
20.01.2017 21:43:41
Al
ich habe eine Frage bezüglich des unten aufgeführten Makros.
Kurze Erläuterung dazu: Das Makro durchsucht Verzeichnisse nach Exceldateien mit > 25 Zeichen und entnimmt diesen bestimmte Werte und listet sie in einer Datei auf...
Das klappt alles super mit zwei Ausnahmen. Zum einen wird die Durchsuchung abgebrochen, wenn in den durchsuchten Verzeichnissen eine temporäre Exceldatei vorhanden ist, die beispielsweise erzeugt wird während die Datei geöffnet ist (z.B. "~Musterblatt.xls").
Zum anderen wird die Durchsuchung gestoppt, da einige Exceldateien noch eine Verknüpfung bzw. Aktualisierungsanforderung enthalten. Der Anwender muss also auf "Weiter" bzw. "Nicht aktualisieren" klicken, damit die Durchsuchung fortgeführt wird.
Hat jemand eine Idee, wie man diese Problemstellung lösen könnte, sodass die Durchsuchung ohne Abbruch bzw. unnötigen Stop durchlaufen kann?
Danke schon mal für die Mühe.
Option Explicit
Dim fso As FileSystemObject
Dim zeileZ As Long
Dim wsZ As Worksheet
Sub DatenAuslesen_mit_Unterverz()
ThisWorkbook.SaveCopyAs (ThisWorkbook.Path & "\" & _
Replace(ThisWorkbook.Name, ".xls", "_backup.xls"))
Dim ergebnis As Long
Dim fd As FileDialog
Dim fol As Folder
Dim letzteZeileZ As Long
Dim pfad As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.InitialFileName = ThisWorkbook.Path & "\"
ergebnis = fd.Show
If ergebnis = 0 Then
' MsgBox Prompt:="Abbruch durch den Benutzer"
Exit Sub
End If
pfad = fd.SelectedItems(1)
Set fso = New FileSystemObject
Set fol = fso.GetFolder(pfad)
Set wsZ = ThisWorkbook.Worksheets("Datenauslese")
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "A").End(xlUp).Row
zeileZ = letzteZeileZ + 1
Folder_abarbeiten Verzeichnis:=fol
Set fso = Nothing
End Sub
Sub Folder_abarbeiten(Verzeichnis As Folder)
Dim fil As File
Dim fol As Folder
Dim pos As Long
Dim suchErgebnis As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim zeichNr As String
Dim zeileStahlgewicht As Long
For Each fil In Verzeichnis.Files
If fil.Name Like "*.xls*" Then
pos = InStrRev(fil.Name, ".")
zeichNr = Left$(fil.Name, pos - 1)
If Len(zeichNr)