Ok, ajd da probamo da resimo problem.
Dodaj novi modul i ubaci ovaj kod. Obrati paznju da putanja, broj kolona, sirine kolona treba da azuriras u ovom kodu.
Code:
Option Explicit
Public FolderPath As String
Public SearchMask As String
Public ImportPosition As String
Public NumberOfColumns As Long
Public Sub UveziPodatke()
Dim l As Long
Dim i As Long
Dim j As Long
Dim s As String
' Application.ScreenUpdating = False
FolderPath = "C:\Excel Test"
SearchMask = "*.txt"
ImportPosition = "A"
NumberOfColumns = 4
With Application.FileSearch
.LookIn = FolderPath
.Filename = SearchMask
If .Execute() > 0 Then
l = 1
For i = 1 To .FoundFiles.Count
s = (ImportFile(.FoundFiles(i), "A" & l, IIf(l = 1, 1, 2)))
Range("A" & l).Select
ActiveCell.Offset(0, NumberOfColumns).Range("A1:A" & Range(s).Rows.Count).Select
Selection.FormulaR1C1 = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(FolderPath) - 1)
l = l + Range(s).Rows.Count
Next i
End If
End With
'Application.ScreenUpdating = True
End Sub
Public Function ImportFile(FN As String, Lok As String, StartR As Long) As String
Dim s As String
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & FN, Destination:=Range(Lok))
.Name = "tab_" & Right(FN, Len(FN) - Len(FolderPath) - 1)
s = .Name
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = StartR
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
' Uneti onoliko 1 (General tip) koliko se kolona unosi
' odnosno sirine fiksnih kolona
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(8, 8, 8)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ImportFile = s
End Function
Ako treba mozemo i da diskutujemo o ovom kodu. Mozda je nesto moglo i jednostavnije,
no ovo je najbrze sto sam mogao da smislim. Napravi par fajlova sa po 4 kolone fiksnih
sirina po 8 karaktera (prve 3 su po 8, poslednja nije bitna). U svakom fajlu neka prvi red
bude naslovni red - on ce se uvoziti samo iz prvog .txt fajla.
Pozdrav