Dateien mit gleichem Namen öffnen
26.08.2003 14:34:21
Roberto
habe ein Problem und hoffe ihr könnt mir helfen!
Ich will mehrere Dateien hintereinander öffnen, bearbeiten und unter dem Namen speichern der in A1 steht. Mein Problem ist das die Dateien alle gleich heißen nur in unterschiedlichen Pfaden stehen also C:\Kunddat\3001\Rechnung.Dat, C:\Kunddat\3003\Rechnung.Dat die Nummer ist nicht fortlaufend. Wäre froh über Lösungsansätze, kann aber auch ausführlich sein da ich kein VBA-Profi bin. Hoffe ich habe Problem gut beschrieben. Vielen dank schon im vorraus, Gruss Roberto
mein Ansatz:
Sub Makro1()
' Makro1 Makro
' Makro am 26.08.2003 von Lager2 aufgezeichnet
Sub Dateiliste_Öffnen()
Dim strVerzeichnis As String
Dim StrDatei As String
Dim I As Integer
Dim StrTyp As String
Dim Dateiname As String
Dim Aktuell_Datei As String
Dim Aktuell_Register As String
' Liste erstellen
Aktuell_Datei = ActiveWorkbook.Name
Aktuell_Register = ActiveSheet.Name
strVerzeichnis = "C:\Kunddat\"
StrTyp = "*.DAT"
Dateiname = Dir(strVerzeichnis & StrTyp)
I = 3
Do While Dateiname <> ""
Cells(I, 1).Value = strVerzeichnis & Dateiname
I = I + 1
Dateiname = Dir
Loop
' Öffnen
For I = 3 To Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open Filename:=Workbooks(Aktuell_Datei).Worksheets(Aktuell_Register).Cells(I, 1)
Origin:=xlWindows, StartRow:=2, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(36, 1), Array(41, 9), Array(68, 9)), _
DecimalSeparator:=".", ThousandsSeparator:=" "
Range("B1:B21").Select
Range("B21").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("A21").Select
ActiveCell.FormulaR1C1 = "=R[-20]C"
Pfad = "C:\Kunddat"
Dasteiname = Cells(1, 1).Value
Datei = Pfad + Trim(Dateiname)+".XLS"
ActiveWorkbook.SaveAs FileName:=Datei,FileFormat_
:=xlNormal, Password:="", WriteResPassword:="",_
ReadOnlyRecommended:= False, CreateBackup:=False
With Application
.DisplayAlerts = False
.DisplayStatusBar = True
.StatusBar = "Änderung an der Datei " _
& ActiveWorkbook.Name & _
"werden nicht gespeichert!"
.Wait (Now + TimeValue("0:00:01"))
.StatusBar = False
End With
Next I
End Sub