Cześć,
Potrzebuję makra do importowania plików .txt z danymi tak żeby wszystkie dane były wczytywane do jednego arkusza jeden pod drugim.
Wzoruje się na tym przykładzie :
> > Option Explicit
>
>
> Sub Demo()
> Dim fso As Object 'FileSystemObject
> Dim fldStart As Object 'Folder
> Dim fld As Object 'Folder
> Dim fl As Object 'File
> Dim Mask As String
>
> Application.ScreenUpdating = False
> Dim newWS As Worksheet
>
> Set newWS = Sheets.Add(before:=Sheets(1))
>
> Set fso = CreateObject("scripting.FileSystemObject") ' late binding
> 'Set fso = New FileSystemObject 'or use early binding (also replace Object types)
>
> Set fldStart = fso.GetFolder("lokalizacja folderu") ' <-- use your FileDialog code here
> Mask = "*.txt"
> 'Debug.Print fldStart.Path & "\"
> ListFiles fldStart, Mask
> For Each fld In fldStart.SubFolders
> ListFiles fld, Mask
> ListFolders fld, Mask
> Next
>
>
> Dim myWB As Workbook, WB As Workbook
> Set myWB = ThisWorkbook
> Dim L As Long, t As Long, i As Long
> L = myWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
> t = 1
> For i = 1 To L
> Workbooks.OpenText Filename:=myWB.Sheets(1).Cells(i, 1).Value, DataType:=xlDelimited, Tab:=True
> Set WB = ActiveWorkbook
> WB.Sheets(1).UsedRange.Copy newWS.Cells(t, 2)
> t = myWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
> WB.Close False
> Next
> myWB.Sheets(1).Columns(1).Delete
> Application.ScreenUpdating = True
> End Sub
>
>
>
>
> Sub ListFolders(fldStart As Object, Mask As String)
> Dim fld As Object 'Folder
> For Each fld In fldStart.SubFolders
> 'Debug.Print fld.Path & "\"
> ListFiles fld, Mask
> ListFolders fld, Mask
> Next
> End Sub
>
>
>
>
> Sub ListFiles(fld As Object, Mask As String)
> Dim t As Long
> Dim fl As Object 'File
> For Each fl In fld.Files
> If fl.Name Like Mask Then
> t = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
> 'Debug.Print fld.Path & "\" & fl.Name
> If Sheets(1).Cells(1, 1) = "" Then
> Sheets(1).Cells(1, 1) = fld.Path & "\" & fl.Name
> Else
> Sheets(1).Cells(t, 1) = fld.Path & "\" & fl.Name
> End If
> End If
> Next
> End Sub
Moje następujące problemy:
- Makro tworzy nowy arkusz zamiast wrzucić dane do konkretnego arkusza np. "Report Data"
- Dane są wrzucane do jednej komórki zamiast do osobnych kolumn przez segregacje poprzez ","
- Byłoby super dodać opcje dodania nazwy pliku txt do pierwszej komórki przed danymi z pliku .txt
PS. Z góry dodam, że jestem totalnym laikiem jeśli chodzi o VBA, przy takich trudniejszych edycjach już mam problemy :)
PZDRCtrl