VBA-Txt files Importieren
22.01.2016 10:37:00
Klausti
ich habe eine Frage an die Profis ;) (der Code ist ebenfalls aus dem Netz)
Ich habe die Frage schon woanderst gestellt aber leider keine Antwort bekommen.
Ich möchte *.txt dateien aus einem Verzeichnis Importieren auf Sheet 2.
Diese Dateien sind aber in Unterschiedlichen Ordnern.
Fix ist der Hauptordner, die Unterorder sind Variable haben aber eine Bekannte Konstante, z.b. xa-1-zb sd-2-sd dabei ist immer das zwischen den beiden - bekannt.
Ich dachte nun könnte man eventuell auf Sheet 1 die Zahl eintragen der dann beim VBA für das Importverfahren genutzt wird.
Leider kenne ich mich nicht wirklich in VBA aus, könnte mir da jemand helfen?
Option Explicit
Private Const sSheetName = "Sheet2"
Sub Input_Files_From_Test1()
Dim oFso As Object, oFile As Object
Set oFso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For Each oFile In oFso.GetFolder(ThisWorkbook.Path).Files
If LCase(oFso.GetExtensionName(oFile.Name)) = "txt" Then
Call TextImport(oFile.Path)
End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub TextImport(ByRef sFileName)
Dim iRowNext As Long
With Sheets(sSheetName)
iRowNext = .Cells(.Rows.Count, "A").End(xlUp).Row
If Not IsEmpty(.Range("A1")) Then
iRowNext = iRowNext + 1
End If
With .QueryTables.Add(Connection:="TEXT;" & sFileName, Destination:=.Cells(iRowNext, "A" _
))
.AdjustColumnWidth = True 'Spaltenbreite automatisch anpassen True/False
.TextFilePlatform = 1252
.TextFileTextQualifier = xlTextQualifierNone
.TextFileParseType = xlDelimited
.TextFileSemicolonDelimiter = True
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.Refresh BackgroundQuery:=False
.Delete
End With
End With
End Sub
Mit freundlichen Grüßen
Klausti