import a many text files to excel programmatically

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have 250 text files(all different names) I need to make them excel files. I
need all columns to remain the same. Columns are fixed width.
Can this be done with a batch file ? I also use vfp9.

thanks
Sherry
 
Ron,
This works but....can each text documrnt be it's own xls file instead of all
text in one file. Some of my files are really large. Also -where did the
macro go? I can't find it when I open a new spreadsheet.

thanks
Sherry
 
Try this one

I assume that you not use Excel 2007


Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_TXT_Files_Tester()
'For Excel 2000 and higher
Dim Fnum As Long
Dim Destwb As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim DateString As String
Dim FolderName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet(Application.DefaultFilePath)
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

'Save as 97-2003 workbook
FileExtStr = ".xls": FileFormatNum = -4143

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = Application.DefaultFilePath & "\" & DateString
MkDir FolderName


'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

'Add new workbook
Set Destwb = Workbooks.Add(1)

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Destwb.Sheets(1).Range("A1"))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1

'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited

'Set your Delimiter to true
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False

'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 9, 1)

'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9

' Get the data from the txt file
.Refresh BackgroundQuery:=False

End With

Destwb.Sheets(1).QueryTables(1).Delete

'Save the workbook and close it
With Destwb
.SaveAs FolderName _
& "\" & Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
InStrRev(TxtFileNames(Fnum), "\", , 1)) & FileExtStr, _
FileFormat:=FileFormatNum
.Close False
End With

Next Fnum


CleanUp:

ChDirNet SaveDriveDir

MsgBox "You can find the files in " & FolderName

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
 
I use 2003. I'll try this.
thanks
sherry

Ron de Bruin said:
Try this one

I assume that you not use Excel 2007


Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_TXT_Files_Tester()
'For Excel 2000 and higher
Dim Fnum As Long
Dim Destwb As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim DateString As String
Dim FolderName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet(Application.DefaultFilePath)
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

'Save as 97-2003 workbook
FileExtStr = ".xls": FileFormatNum = -4143

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = Application.DefaultFilePath & "\" & DateString
MkDir FolderName


'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

'Add new workbook
Set Destwb = Workbooks.Add(1)

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Destwb.Sheets(1).Range("A1"))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1

'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited

'Set your Delimiter to true
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False

'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 9, 1)

'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9

' Get the data from the txt file
.Refresh BackgroundQuery:=False

End With

Destwb.Sheets(1).QueryTables(1).Delete

'Save the workbook and close it
With Destwb
.SaveAs FolderName _
& "\" & Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
InStrRev(TxtFileNames(Fnum), "\", , 1)) & FileExtStr, _
FileFormat:=FileFormatNum
.Close False
End With

Next Fnum


CleanUp:

ChDirNet SaveDriveDir

MsgBox "You can find the files in " & FolderName

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Click to expand...
 
ron,

This worked fine when I first ran it 8/31/2007 but today it wants me to
select the text files one at a time.

Could some setting in excel be wrong?

Thanks
Sherry
 
Sorry,

I guess I had a 'senior' moment. I forgot to select all the files with
shift select.

Works great!!!! Operator error...

thanks
Sherry
 
One more question--My excel doesn't close automatically. Can I fix this?

What do you mean with this

What code do you use to close Excel
 
The code in the Excel macro. Should this not close worksheets and Excel

Show me the code that you use now
 
ron

It's the code from your site (with a few path changes)
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName
As String) As Long

Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_TXT_Files_Tester()
'For Excel 2000 and higher
Dim Fnum As Long
Dim Destwb As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
Dim DateString As String
Dim FolderName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

'Save the current dir
SaveDriveDir = CurDir

'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path

ExistFolder = ChDirNet("q:\reserves\txt\acchlthdetailtxt")
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If

'Save as 97-2003 workbook
FileExtStr = ".xls": FileFormatNum = -4143

TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)

If IsArray(TxtFileNames) Then

On Error GoTo CleanUp

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = "q:\reserves\txt\acchlthdetailtxt" & "\" & DateString
MkDir FolderName


'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)

'Add new workbook
Set Destwb = Workbooks.Add(1)

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum),
Destination:=Destwb.Sheets(1).Range("A1"))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1

'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited

'Set your Delimiter to true
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False

'Set the format for each column if you want (Default =
General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 9, 1)

'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9

' Get the data from the txt file
.Refresh BackgroundQuery:=False

End With

Destwb.Sheets(1).QueryTables(1).Delete

'Save the workbook and close it
With Destwb
.SaveAs FolderName _
& "\" & Right(TxtFileNames(Fnum),
Len(TxtFileNames(Fnum)) - _

InStrRev(TxtFileNames(Fnum), "\", , 1)) & FileExtStr, _
FileFormat:=FileFormatNum
.Close False
End With

Next Fnum


CleanUp:

ChDirNet SaveDriveDir

MsgBox "You can find the files in " & FolderName

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
 
It will close all workbooks it create for you in the new folder

What do you see ?

And there is no code to close Excel in my macro
 
Back
Top