Hallo Leuts,
da wir auf das wundertolle Office 2007 umgestiegen sind, musste ich jetzt einige Makros umschreiben.
Folgendes Makro kontrolliert das Vorhandensein diverser Dokumente auf verschiedenen Laufwerken und vermerkt dies anschließend in einer Excel-Tabelle.
Die nicht mehr vorhandene Application.FileSearch-Funktion habe ich mit der FileList-Funktion substituiert. Dies funktioniert auch problemlos. Das Makro läuft einmal "durch" und sollte dann in die nächste Zeile der ExcelTabelle springen und für die nächste Dateinummer weitersuchen.
Jedoch bleibt es immer in der 5.-letzten Zeile ("myName = Dir() ' Get next entry.") hängen und spuckt mir obenstehende Fehlermeldung aus.
Ohne die File-List-Blöcke funktioniert das Auflisten der Dateien auch. Ebenso Funktionieren die File-List-Blöcke auch einzeln bzw. im "Ganzen" einmal (bis zur Fehlemeldung
Nun habe ich keine Ahnung mehr woran es noch liegen könnte. Ich suche schon seit Stunden nach dem Fehler und finde keine Lösungsansatz, was mich der Verzweiflung immer näher bringt.
Ich hoffe einer von euch Profis kann mir vielleicht einen Tip oder Lösungsansatz geben.
Andernfalls bleibt mir wohl nur die komplette neu-Programmierung, oder? Was allerdings ziemlich schade wäre, da ziemlich viel Arbeit in dem Makro steckt und es ja soweit (1mal) funktioniert.
Vielen Dank im Voraus für eure Hilfe, welcher Art auch immer.
MfG der verzweifelte, beinahe suizidale Hakke-Schorb!
da wir auf das wundertolle Office 2007 umgestiegen sind, musste ich jetzt einige Makros umschreiben.
Folgendes Makro kontrolliert das Vorhandensein diverser Dokumente auf verschiedenen Laufwerken und vermerkt dies anschließend in einer Excel-Tabelle.
Die nicht mehr vorhandene Application.FileSearch-Funktion habe ich mit der FileList-Funktion substituiert. Dies funktioniert auch problemlos. Das Makro läuft einmal "durch" und sollte dann in die nächste Zeile der ExcelTabelle springen und für die nächste Dateinummer weitersuchen.
Jedoch bleibt es immer in der 5.-letzten Zeile ("myName = Dir() ' Get next entry.") hängen und spuckt mir obenstehende Fehlermeldung aus.
Ohne die File-List-Blöcke funktioniert das Auflisten der Dateien auch. Ebenso Funktionieren die File-List-Blöcke auch einzeln bzw. im "Ganzen" einmal (bis zur Fehlemeldung
Nun habe ich keine Ahnung mehr woran es noch liegen könnte. Ich suche schon seit Stunden nach dem Fehler und finde keine Lösungsansatz, was mich der Verzweiflung immer näher bringt.
Ich hoffe einer von euch Profis kann mir vielleicht einen Tip oder Lösungsansatz geben.
Andernfalls bleibt mir wohl nur die komplette neu-Programmierung, oder? Was allerdings ziemlich schade wäre, da ziemlich viel Arbeit in dem Makro steckt und es ja soweit (1mal) funktioniert.
Vielen Dank im Voraus für eure Hilfe, welcher Art auch immer.
MfG der verzweifelte, beinahe suizidale Hakke-Schorb!
Visual Basic-Quellcode
- Public Function FileList(fldr As String, Optional fltr As String = "*.*") As _
- Variant
- Dim sTemp As String, sHldr As String
- If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
- sTemp = Dir(fldr & fltr)
- If sTemp = "" Then
- FileList = Split("No files", "|") 'ensures an array is returned
- Meldung = MsgBox("Es wurde keine Datei " & fltr & " gefunden." & vbCrLf _
- & "Weiter machen?", vbYesNo)
- If Meldung = vbNo Then End
- Exit Function
- End If
- Do
- sHldr = Dir
- If sHldr = "" Then Exit Do
- sTemp = sTemp & "|" & sHldr
- Loop
- FileList = Split(sTemp, "|")
- End Function
- Private Sub aktualisieren_Click()
- ' Macro zur Übersicht des MeasImport-Laufwerkes
- ' Display the names in C:\ that represent directories.
- Kpath = "k:\" ' Set the path.
- datapath = "G:\Test-Coordination (01424471)\WO-Closed\"
- kanalpath = "g:\dynamic (01424474)\Test Data\Vorlagen\Kanallisten\"
- myName = Dir(Kpath, vbDirectory) ' Retrieve the first entry.
- zeile_ = 3
- Worksheets("MeasImport").Range("H1").Value = Now()
- Range("A3").Select
- Do While myName <> "" ' Start the loop.
- Debug.Print myName
- ' Ignore the current directory and the encompassing directory.
- If myName <> "." And myName <> ".." Then '
- 'MsgBox (Mid(myname, 1, 1))
- 'Use bitwise comparison to make sure MyName is a directory.
- If (GetAttr(Kpath & myName) And vbDirectory) = vbDirectory Then
- If (Mid(myName, 1, 1) = "0" Or Mid(myName, 1, 1) = "1" Or Mid(myName, _
- 1, 1) = "2" Or Mid(myName, 1, 1) = "3" Or Mid(myName, 1, 1) = "4" Or _
- Mid(myName, 1, 1) = "5" Or Mid(myName, 1, 1) = "6" Or Mid(myName, 1, _
- 1) = "7" Or Mid(myName, 1, 1) = "8" Or Mid(myName, 1, 1) = "9") And _
- Mid((Right(myName, 4)), 1, 1) <> "." Then
- Debug.Print myName ' Display entry only if it
- MsgBox myName
- Worksheets("MeasImport").Range("B" & zeile_).Value = myName
- 'Kanalliste
- kw_ = Mid(myName, 1, 2)
- wo_ = Mid(myName, 3, 7)
- to_ = Mid(myName, 3)
- Liste = FileList(kanalpath & "Kw" & kw_ & "\", myName & ".xls")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
- Worksheets("MeasImport").Range("C" & zeile_).Value = " x "
- Auswahl = MsgBox(Meldung, vbOKCancel)
- Else
- Worksheets("MeasImport").Range("C" & zeile_).Value = ""
- End If
- 'Testreport
- Liste = FileList(Kpath & myName & "\", "*testreport_sledx*")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
- Worksheets("MeasImport").Range("G" & zeile_).Value = " x "
- Range("B" & zeile_).Select
- ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
- Kpath & myName & "\testreport_sledx.docx"
- With Selection.Font.Size = 8
- Auswahl = MsgBox(Meldung, vbOKCancel)
- End With
- Else
- Worksheets("MeasImport").Range("C" & zeile_).Value = ""
- End If
- 'Diagramme
- Liste = FileList(Kpath & myName & "\", "*.png")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl Worksheets("MeasImport").Range("D" & zeile_).Value = " x "
- Auswahl = MsgBox(Meldung, vbOKCancel)
- Else
- Worksheets("MeasImport").Range("D" & zeile_).Value = ""
- End If
- 'Fotos
- Liste = FileList(Kpath & myName & "\", "*.jpg")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
- Worksheets("MeasImport").Range("E" & zeile_).Value = " x "
- Auswahl = MsgBox(Meldung, vbOKCancel)
- Else
- Worksheets("MeasImport").Range("E" & zeile_).Value = ""
- End If
- 'Videoanalyse
- Liste = FileList(Kpath & myName & "\", "*videoanalyse*")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
- Worksheets("MeasImport").Range("F" & zeile_).Value = " x "
- Auswahl = MsgBox(Meldung, vbOKCancel)
- Else
- Worksheets("MeasImport").Range("F" & zeile_).Value = ""
- End If
- 'freedat
- Liste = FileList(Kpath & myName & "\", "free.dat")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
- Worksheets("MeasImport").Range("H" & zeile_).Value = " x "
- Auswahl = MsgBox(Meldung, vbOKCancel)
- Else
- Worksheets("MeasImport").Range("H" & zeile_).Value = ""
- End If
- 'sled-data
- Liste = FileList(datapath & "\" & wo_ & "\" & to_, _
- "*testreport_sledx*")
- If Liste(0) <> "No files" Then
- Anzahl = UBound(Liste) - LBound(Liste) + 1
- Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
- Worksheets("MeasImport").Range("I" & zeile_).Value = " x "
- Auswahl = MsgBox(Meldung, vbOKCancel)
- Else
- Worksheets("MeasImport").Range("I" & zeile_).Value = ""
- End If
- zeile_ = zeile_ + 1
- 'End If ' it represents a directory.
- End If
- End If
- End If
- myName = Dir() ' Get next entry.
- MsgBox (myName)
- Loop
- Range("B3").Select
- End Sub