AW: Dateien verschieben
15.03.2010 18:45:42
JOWE
Hallo Walter,
welche der BuiltInProperties enthält denn den Text "0301"?
Im folgenden Code gehe ich davon aus, dass es sich um den Kommentar handelt und das dort tatsächlich nur diese 4 Zeichen drin stehen. Die verschobenen Dateien werden in der Arbeitsmappe aufgelistet, in der Du dieses Makro laufen läßt; und zwar in Sheet(1):
Sub jupp()
Application.ScreenUpdating = False
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim i As Integer
Dim name1, pfad1, pfad2 As String
i = 1
pfad1 = "c:\temp\quelle\" 'anpassen!!!
pfad2 = "c:\temp\ziel\" 'anpassen!!!
name1 = Dir("*.xls")
Workbooks.Open pfad1 & "\" & name1
If ActiveWorkbook.BuiltinDocumentProperties(5) = "0301" Then
ActiveWorkbook.Close savechanges:=False
ActiveWorkbook.Sheets(1).Cells(i, 1) = pfad1
ActiveWorkbook.Sheets(1).Cells(i, 2) = name1
fso.MoveFile pfad1 & name1, pfad2 & name1
Else
ActiveWorkbook.Close savechanges:=False
End If
While name1 ""
name1 = Dir
If name1 = "" Then Exit Sub
Workbooks.Open pfad1 & "\" & name1
If ActiveWorkbook.BuiltinDocumentProperties(5) = "0310" Then
i = i + 1
ActiveWorkbook.Close savechanges:=False
ActiveWorkbook.Sheets(1).Cells(i, 1) = pfad1
ActiveWorkbook.Sheets(1).Cells(i, 2) = name1
fso.MoveFile pfad1 & "\" & name1, pfad2 & "\" & name1
Else
ActiveWorkbook.Close savechanges:=False
End If
Wend
Set fso = Nothing
End Sub
Gruß
Jochen