Help importing "Text to Columns" repeatedly

  • Thread starter Thread starter Nightsky
  • Start date Start date
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
 
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
 
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

Back
Top