AW: Ups..........
31.12.2005 17:55:41
Reinhard
Hi Peter,
so wie ich die Hilfe zu workbooks.open lese dürfte kein Makro ausgeführt werden.
Trotzdem hängt sich das makro an einer Datei bei mir auf und zeigt mir eine UF o.ä. , kann aber auch ne seltsame Passwortabfrage sein, muss das erst noch ergründen.
Teste es mal bei dir, vielleicht screenupdating=false weglassen, damit du siehst ob zumindest der Anfang stimmt wenn es sich bei dir auch aufhängt.
Kann ach sein dass die Namensüberprüfung auf eigenen Namen noch falsch läuft. uss das erst checken.
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test()
Dim finden, zei, pfad
Application.ScreenUpdating = False
On Error Resume Next ' wenn Sonderzeichen im Dateinamen gibt es ggfs Fehler
Close
Open "c:\test\alle.bat" For Output As #1
Print #1, "dir c:\*.xls /s/b/-p > c:\test\alle.txt"
Close
finden = Shell("c:\test\alle.bat")
'Sleep 1000 'Hier ggfs Wartezeit in Milisekunden angeben wenn viele Dateien
Range("A1:E1") = Split("Pfad Datei Größe Erstellung Änderung")
zei = 1 'Überschriftszeile
Open "c:\test\alle.txt" For Input As #1
With ActiveSheet
While Not EOF(1)
Input #1, pfad
zei = zei + 1
.Cells(zei, 1) = pfad
.Cells(zei, 2) = Mid(pfad, InStrRev(pfad, "\") + 1)
If ThisWorkbook.Name <> Mid(pfad, InStrRev(pfad, "\") + 1) Then
Workbooks.Open Filename:=pfad, updatelinks:=0, ReadOnly:=True
.Cells(zei, 3) = FileLen(pfad)
.Cells(zei, 4) = ActiveWorkbook.BuiltinDocumentProperties(11)
.Cells(zei, 5) = ActiveWorkbook.BuiltinDocumentProperties(12)
Workbooks(Mid(pfad, InStrRev(pfad, "\") + 1)).Close
End If
Wend
End With
Close
Range("A1:D" & zei).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
ps:Das Forum lebt auch von Rückmeldungen.