Help importing "Text to Columns" repeatedly

N

Nightsky

I have a huge number of txt files that we need to import to Excel. Th
problem is that I have to import them one at a time and will have to d
this every day in the future. Here is an example of what it look
like:

Code
-------------------

Column 1 Data Column 2 Column 3 Not fixed width
Data1 Data 2 goes here Data 3 goes here

-------------------

As you can see the data is aligned on the left with the longest dat
string setting the column width. This can be a data value or th
column heading... Only spaces are present not tabs. Currently I hav
to do a Text to Columns and manually set each column width. All m
reports have these standard widths for each column.

Is there any way to save a "Text to Columns" style or make a new impor
style with these settings?

Mik
 
D

Dave Peterson

Are you saying the .txt files are all laid out the same (when it comes to
columnwidths for each field)?

If that's true,

Create a new workbook
start recording a macro
File|open the first text file
parse those fields the way you need to
keep recording the macro when you add headers/filters/page layout.

Then stop recording.

That recorded macro could be tweaked to ask for a filename (or multiple
filenames within the same folder).

Something like:

Option Explicit
Sub testme01()

Dim wkbk As Workbook
Dim myFileNames As Variant
Dim NewFileName As String
Dim iCtr As Long

myFileNames = Application.GetOpenFilename("Text Files, *.txt", _
MultiSelect:=True)

If IsArray(myFileNames) = False Then
Exit Sub
End If

For iCtr = LBound(myFileNames) To UBound(myFileNames)
'modify this line according to your recorded macro
'fieldinfo:= will change
Workbooks.OpenText Filename:=myFileNames(iCtr), _
Origin:=437, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(7, 1), _
Array(11, 1), Array(19, 1), Array(21, 1))

Set wkbk = ActiveWorkbook

'your code to do all the formatting

'save it in the same folder, but as an excel file
NewFileName _
= Left(myFileNames(iCtr), Len(myFileNames(iCtr)) - 4) & ".xls"

wkbk.SaveAs Filename:=NewFileName, FileFormat:=xlWorkbookNormal
wkbk.Close savechanges:=False
Next iCtr

End Sub
 
N

Nightsky

With a bit of tweeking and trouble shooting I got this to work very
well.

Thank you,
Mike
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top