Sub dateien()
Dim Dateiname As String, i As Integer
Dateiname = Dir$("c:\vt\boerse\*.*")
Do While Dateiname <> ""
Range("a3").Offset(i, 0) = Dateiname
i = i + 1
Dateiname = Dir$()
Loop
End Sub
Sub WordListe()
Dim sFile As String, sPath As String, zeilennr As Long
Dim FSObjekt As Object, FObjekt As Object
Dim WordApp As Object, WordDoc As Object
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
Application.ScreenUpdating = False
Set FSObjekt = CreateObject("Scripting.FileSystemObject")
sPath = "C:\PFAD"
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath)
Do While sFile <> ""
If Right(sFile, 3) = "doc" Then
zeilennr = Range("A65536").End(xlUp).Row + 1
Cells(zeilennr, 1) = sFile
Set FObjekt = FSObjekt.GetFile(sPath & sFile)
Cells(zeilennr, 2) = FObjekt.DateLastModified
Cells(zeilennr, 3) = FObjekt.Size
WordApp.Application.Documents.Open sPath & sFile
Cells(zeilennr, 4) = WordApp.ActiveDocument.BuiltinDocumentProperties(3).Value
sFile = Dir()
End If
Loop
Set WordApp = Nothing
Application.ScreenUpdating = False
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen