VBA Macro um Inhalt eines Ordners auszulesen
29.01.2016 17:11:10
André
Folgender Sachverhalt:
Ich synchronisiere über mehrere Rechner hinweg Daten, eine xlsm fungiert dabei u.a. als Inhaltsverzeichnis. Um weitere Informationen über den Ordnerinhalt zu bekommen, habe ich ein VBA Makro der xlsm hinzugefügt, welche mir relevante Informationen anzeigt. Das funktioniert soweit ganz gut, sofern ich einen absoluten Ordnerpfad Const STRFOLDER As String = "D:\Projekte_Sync\" angebe; da ich jedoch wie o.g. die Daten über mehrere Rechner hinweg synchronisiere - sich dementsprechend die Pfade je nach Rechner unterscheiden - würde ich als Pfad gerne einen relativen Bezug angeben (ausgehend vom Ordner der Excel).
Das VBA Makro lautet wie folgt:
Public Sub Auto_Open()
Const STRFOLDER As String = "D:\Projekte_Sync\"
Dim objShell As Object, objFolder As Object
Dim bytIndex As Byte, intColumn As Integer, lngRow As Long
Dim varName, arrHeaders(37)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
Exit Sub
End If
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
intColumn = 1
For bytIndex = 0 To 37
arrHeaders(bytIndex) = objFolder.GetDetailsOf(varName, bytIndex)
Cells(1, intColumn + bytIndex) = arrHeaders(bytIndex)
Next
Rows(1).Font.Bold = True
lngRow = 2
For Each varName In objFolder.Items
For bytIndex = 0 To 37
Cells(lngRow, intColumn + bytIndex) = objFolder.GetDetailsOf(varName, bytIndex)
Next
lngRow = lngRow + 1
Next
Columns.AutoFit
Set objShell = Nothing
Set objFolder = Nothing
Application.ScreenUpdating = True
End Sub
Wie kann ich in der o.g. Zeile den Pfad für meine Bedürfnisse anpassen (habe hinsichtlich VBA nur rudimentäre Kenntnisse)?
Vielen Dank fürs Lesen,
André
Anzeige