Letztes Änderungsdatum abgleichen
Peter
Mit einem Makro in der Datei "Exporte_zusammenfuegen_V20111018A.xls" ( vgl. https://www.herber.de/bbs/user/77063.xls ) wird eine neue Datei "Exporte.xls" erstellt und aus allen Exceldateien, die in einem bestimmten Pfad gespeichert sind, ein bestimmter Datenrange aus "Tabelle1" in die neue Datei kopiert. Die Daten werden jeweils in eine Tabelle eigefügt, die mit dem Namen der Quelldatei benannt wird.
Wenn einzelne Quelldateien aktualisiert werden, starte ich das Makro jeweils erneut. Da es sich um sehr viele Quelldateien handeln kann, möchte ich nun, dass nur Quelldateien berücksichtigt werden, von denen es entweder in der Zieldatei noch keine entsprechende Tabelle gibt oder wenn die letzte Speicherung der Quelldatei später erfolgte als die Datei Exporte.
Do While strFile ""
'*********************
''' wenn Datum/Zeit von strFile ist grösser als Speicherdatum der Datei Exporte
''' (Wert aus [_ExpSpeicherdatum])oder
''' in dieser Datei exisitiert keine Worksheet mit dem namen von strFile, dann
''' Daten neue Tabelle mit Name von strFile anlegen und Daten kopieren
''' sonst weitergehen zu WEITER:
Um diese Information aus der geschlossenen Datei zu holen, kabe ich ein Code von k.rola gefunden, der die entsprechende Zeit aller Dateien in Spalte D auflistet (vgl. nachstehend). Ich habe jedoch nicht herausgefunden, wie ich diese Information pro Datei in der Schlaufe einer Variable zuweisen kann.
Wer kann mir da weiterhelfen?
Danke und Gruss, Peter
Sub FileProperties_in_Folder()
'von k.rola
Const STRFOLDER As String = "C:\Testdaten" 'anpassen
Dim objShell As Object
Dim objFolder As Object
Dim x As Byte
Dim spalte As Integer
Dim zeile As Long
Dim varName, arrHeaders(34)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!" & Space(10), 64, "weise hin... _
" 'anpassen
Exit Sub
End If
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
spalte = 1
For x = 0 To 33
arrHeaders(x) = objFolder.GetDetailsOf(varName, x)
Sheets("Auswertung").Cells(1, spalte + x) = arrHeaders(x) 'anpassen
Next
Rows(1).Font.Bold = True
zeile = 2
For Each varName In objFolder.Items
For x = 0 To 33
Sheets("Auswertung").Cells(zeile, spalte + x) = objFolder.GetDetailsOf(varName, x) ' _
anpassen
Next
zeile = zeile + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub