AW: Dateien auf Serverlaufwerk auslesen
23.05.2018 15:48:46
UweD
Hallo
so?
Sub Dateien()
Dim FSO, F, Datei, i As Integer, Pfad As String, Ext As String
Dim TB1, WB2, TB2, DatumVon As Date, DatumBis As Date, SP As Integer
On Error GoTo Fehler
'****
Pfad = "X:\Temp\"
SP = 2 ' Zielspalte
DatumVon = InputBox("Von Datum", "Eingabe Dateum", Date - 300)
DatumBis = InputBox("Von Datum", "Eingabe Dateum", Date)
Ext = "xls" 'auch mit x und m
Set TB1 = ThisWorkbook.Sheets("Tabelle1")
'****
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Datei In FSO.getFolder(Pfad).Files
If InStr(LCase(FSO.GetExtensionName(Datei)), LCase(Ext)) > 0 Then
Set F = FSO.getfile(Datei)
If F.DateCreated >= DatumVon And F.DateCreated <= DatumBis Then
'mach was damit
Workbooks.Open Filename:=Datei
Set WB2 = ActiveWorkbook
Set TB2 = WB2.Sheets(1)
i = i + 1
'Daten übertragen
TB1.Cells(i, SP) = TB2.Range("A1") 'Beispiel
TB1.Cells(i, SP).Offset(0, 1) = TB2.Range("B1")
WB2.Close False 'schliessen ohne speichern
End If
End If
Next
Err.Clear
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD