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:

  1. Makro tworzy nowy arkusz zamiast wrzucić dane do konkretnego arkusza np. "Report Data"
  2. Dane są wrzucane do jednej komórki zamiast do osobnych kolumn przez segregacje poprzez ","
  3. 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