automating import of several text files from specified folder

  • Thread starter Thread starter DnD
  • Start date Start date
D

DnD

i need a macro that will automatically import text files (fixed width) from a
specific folder. the number and names of the files in the folder will vary at
any given time. i would also like the files to be imported to the same sheet
(there's not too much data per text file).
 
See if this helps. You have to change ColTable for the number of columns you
have, the length and starting position.

Sub fixwidth()
Const ForReading = 1, ForWriting = 2, _
ForAppending = 3
Const Folder = "c:\temp\test\"
Const StartPos = 0
Const ColWidth = 1

Dim ColTable(6, 2)
ColTable(0, StartPos) = 1
ColTable(0, ColWidth) = 10
ColTable(1, StartPos) = 11
ColTable(1, ColWidth) = 5
ColTable(2, StartPos) = 16
ColTable(2, ColWidth) = 8
ColTable(3, StartPos) = 24
ColTable(3, ColWidth) = 3
ColTable(4, StartPos) = 27
ColTable(4, ColWidth) = 6
ColTable(5, StartPos) = 33
ColTable(5, ColWidth) = 4

NumberColumns = UBound(ColTable)

Set fs = CreateObject("Scripting.FileSystemObject")

If Range("A1") = "" Then
RowCount = 1
Else
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
RowCount = Lastrow
End If

First = True
Do
If First = True Then
Filename = Dir(Folder & "*.txt")
First = False
Else
Filename = Dir()
End If
If Filename <> "" Then
Set fin = fs.OpenTextFile(Folder & Filename, _
ForReading, TristateFalse)
Do While fin.AtEndOfStream <> True
readdata = fin.readline

For Colcount = 0 To (NumberColumns - 1)
Data = Mid(readdata, _
ColTable(Colcount, StartPos), _
ColTable(Colcount, ColWidth))

Cells(RowCount, Colcount + 1) = Data
Next Colcount
RowCount = RowCount + 1
Loop
fin.Close
End If
Loop While Filename <> ""
End Sub
 
Back
Top