AW: mit DIR werden keine Dateien erkannt
19.09.2011 09:39:10
Peter
Hallo Seli
Vielen Dank. Jetzt nimmt es jedoch nur die erste Datei - alle anderen werden ignoriert. Wo habe ich noch einen weiteren Fehler?
Gruss, Peter
Option Explicit
Sub Exporte_in_eine_Datei()
Dim strTmpName As String, strExpPfad As String, strExportPfad As String, wkb As Workbook, _
strFile As String
Dim wkbExp As Workbook
ThisWorkbook.Activate: Calculate
strExpPfad = Range("expPfad") & "\" 'Pfad der Exporte
strExportPfad = Range("datpfad") & "\" 'Pfad, in welcher die Datei "Exporte.xls gespeichert _
wird
strTmpName = "Exporte.xls"
strFile = Dir(strExpPfad & "*.xls")
If strFile = "" Then
MsgBox "Keine Dateien gefunden!", vbOKOnly, "Gebe bekannt ..."
Exit Sub
End If
'jede Tabelle im angegebenen Pfad öffnen, "Tabelle1" kopieren in eine Tabelle, welche mit dem
'Namen der Datei (ohne Extension .xls) benannt wird
Do While strFile ""
If wkbExp Is Nothing Then Set wkbExp = Workbooks.Add(1)
Set wkb = Workbooks.Open(strExpPfad & strFile)
wkb.Sheets("Tabelle1").Copy before:=wkbExp.Sheets(1)
wkbExp.Sheets(1).Name = Left(strFile, Len(strFile) - 4)
wkb.Close False
strFile = Dir
Loop
With wkbExp
Application.DisplayAlerts = False
.Sheets(.Sheets.Count).Delete
Application.DisplayAlerts = True
.SaveAs strExportPfad & strTmpName
End With
End Sub