Datei übersprigen, wenn geöffnet
06.04.2007 16:09:07
Matthias
ich habe hier ein Makro, das die Eigenschaften von allen Dateien in einem bestimmten Ordner ausliest. Notwendig ist dazu eine spezielle dll von http://www.microsoft.com/germany/technet/datenbank/articles/600696.mspx . So weit klappt der Code prima. Ein Problem tritt aber auf, wenn eine von den Dateien geöffnet ist - dann bricht das Makro mit einer Fehlermeldung ab. Ich hätte nun gerne, das bei jeder Datei zuerst geprüft wird, ob sie geöffnet ist; wenn ja, soll sie übersprungen werden und die nächste Datei ausgelesen werden. Hier die Datei und der Code:
https://www.herber.de/bbs/user/41617.xls
Sub Auslesen()
Dim myFileSystemObject As FileSystemObject, myFile As File, lngRow As Long
Dim objFilePropReader As Object
Dim objDocProp As Object
Set objFilePropReader = CreateObject("DSOFile.OleDocumentProperties")
Set myFileSystemObject = New FileSystemObject
lngRow = 2
With Worksheets("Archiv")
.Range(.Cells(2, 1), .Cells(Rows.Count, 256)).ClearContents
For Each myFile In myFileSystemObject.GetFolder("S:\Dept\A032\032.3\Dateiverwaltung"). _
Files '' Verzeichnis anpassen!
objFilePropReader.Open myFile
Set objDocProp = objFilePropReader.SummaryProperties
.Cells(lngRow, 1) = myFile.Name
.Cells(lngRow, 2) = myFile.Type
.Cells(lngRow, 3) = myFile.DateCreated
.Cells(lngRow, 4) = myFile.DateLastModified
.Cells(lngRow, 5) = objDocProp.Title
.Cells(lngRow, 6) = objDocProp.Subject
.Cells(lngRow, 7) = objDocProp.Author
.Cells(lngRow, 8) = objDocProp.Category
.Cells(lngRow, 9) = objDocProp.Keywords
.Cells(lngRow, 10) = objDocProp.Comments
lngRow = lngRow + 1
objFilePropReader.Close
Next
End With
objFilePropReader.Close
Set objFilePropReader = Nothing
Set objDocProp = Nothing
Set myFileSystemObject = Nothing
End Sub
Anzeige