Progressbar in Schleife einbinden
05.08.2015 13:23:52
Uli
ich habe eine Prozedur, die Dateien in meinem Netzwerk sucht und die Dateinamen in ein Tabellenblatt einträgt.
Da die Dateien ziemlich verstreut sind, dauert die Prozedur etwas länger. Ich möchte gerne eine Progressbar in diese Schleife einbinden und schaff es nicht.
Kann mir da mal jemand helfen?
Ein Auszug aus dem Code:
Private Sub cmdEinlesen_Click()
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fdateien As Object
Dim strDat As String, blatt1 As String, blatt2 As String
Dim Zeile As Integer, anzfehler As Integer
Dim jahr As String
Dim aw
Set myrange = Range("Monatsverzeichnis")
blatt1 = "Dateinamen"
blatt2 = "Stammdaten"
monat = Me.ComboBox1
Zeile = 5
anzfehler = 0
'On Error GoTo abbruch
Set fs = CreateObject("scripting.FileSystemObject")
'Hier das Verzeichnis angeben, welches durchsucht werden soll
Set fVerz = fs.getFolder(Sheets(blatt2).[f2] & "\" & Me.ComboBox2.Value & "\" & Application. _
WorksheetFunction.VLookup(monat, myrange, 2, False) & "\Listen\")
Set fdateien = fVerz.Files
On Error GoTo fehler
Sheets(blatt1).[c6:c532].ClearContents 'Dateinamenspalte löschen
Sheets(blatt1).[f6:f532].ClearContents 'Versandbestätigung löschen
For Each fDatei In fdateien
If InStr(fDatei, "") > 0 Then
Zeile = Zeile + 1
'Hier wird der Dateiname in Spalte C eingetragen
Sheets(blatt1).Cells(Zeile, 3) = fDatei.Name
End If
GoTo weiter
fehler:
anzfehler = anzfehler + 1
weiter:
On Error Resume Next
Next
Set fs = Nothing
Set fVerz = Nothing
Set fdateien = Nothing
If anzfehler > 0 Then
aw = MsgBox("Dateinamen: Es gab " & anzfehler & " Fehler bei der Ausführung des Makros!", _
vbInformation, "Oops...")
Me.lblstatus.Caption = anzfehler & " Fehler"
Else
Me.lblstatus = "OK"
End If
Me.lblstatusversand = "" 'Versandinnformation löschen
Exit Sub
abbruch:
aw = MsgBox("Dateinamen: Fehler mit Makroabbruch", vbInformation, "Oops...")
Me.lblstatus = "Abbruch des Makros"
End Sub
Anzeige