VBA - Einlesen von xls-Dateien - Codeumstellung
09.07.2015 12:15:39
xls-Dateien
mit dem folgenden Code hatte ich immer CSV-Dateien eingelesen, ab jetzt wollte ich damit xls-Dateien einlesen. Die Dateinamen bis strPath = "D:\EXPORTE\" habe ich bereits geändert.
Am Teil ab For intc habe ich noch nichts verändert, meine Versuche den Code umzuschreiben, damit xls-Dateien eingelesen werden haben nicht funktioniert.
Wer kann helfen?
Option Explicit
Sub Import() 'bis 08.07.2015 aus CSV-Dateien, ab 09.07.2015 aus xls-Dateien
Application.ScreenUpdating = False
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
.Cursor = xlWait
End With
Sheets("A_Xls_Export").Range("A:BZ").ClearContents 'bis 08.07.2015 Sheets("A_Csv_Export")
Sheets("B_Xls_Export").Range("A:BZ").ClearContents 'bis 08.07.2015 Sheets ("B_Csv_Export")
Sheets("C_Xls_Export").Range("A:BZ").ClearContents 'bis 08.07.2015 Sheets ("C_Csv_Export")
Sheets("D_Xls_Export").Range("A:BZ").ClearContents 'bis 08.07.2015 Sheets ("D_CSV_Export")
Dim arrStrings(3, 1) As Variant
Dim intc As Integer
Dim strPath As String
arrStrings(0, 0) = "A_Xls_Export" ' Tabelle für Datei 1 - _
Anpassen!
arrStrings(0, 1) = "a_xls_export.xls" ' Name von Datei 1 - Anpassen!
arrStrings(1, 0) = "B_Xls_Export" ' Tabelle für Datei 2 - _
Anpassen!
arrStrings(1, 1) = "a_xls_export.xls" ' Name von Datei 2 - Anpassen!
arrStrings(2, 0) = "C_Xls_Export" ' Tabelle für Datei 3 _
- Anpassen!
arrStrings(2, 1) = "a_xls_export.xls" ' Name von Datei 3 - Anpassen!
arrStrings(3, 0) = "D_Xls_Export" ' Tabelle für Datei 3 _
- Anpassen!
arrStrings(3, 1) = "a_xls_export.xls" ' Name von Datei 3 - Anpassen!
strPath = "D:\EXPORTE\" ' Pfad zu den Dateien - Anpassen! _
For intc = 0 To UBound(arrStrings)
Sheets(arrStrings(intc, 0)).Range("A2:IV65536").ClearContents
With Sheets(arrStrings(intc, 0)).QueryTables.Add(Connection:="TEXT;" & strPath & _
arrStrings(intc, 1) _
, Destination:=Sheets(arrStrings(intc, 0)).Range("A2"))
.Name = arrStrings(intc, 0)
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = False
.AdjustColumnWidth = True
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.Refresh BackgroundQuery:=False
Sheets("Differenzen").Select
End With
If Sheets(arrStrings(intc, 0)).Range("F1") = "Vorname2" Then
Sheets(arrStrings(intc, 0)).Columns("F:G").Delete
End If
If Sheets(arrStrings(intc, 0)).Range("H1") = "Familienname2" Then
Sheets(arrStrings(intc, 0)).Columns("F:F").Delete
End If
Next
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.Cursor = xlDefault
End With
End Sub