Loop to open text files, edit, then saveAs .xls

Hi, apologies if this duplicates other threads but I've been searching these forums and Googling for a couple of days now and can't find a solution to my problem.

What I want to do is:
- Set up a loop to open each text file in a folder
- If possible, have a user prompt to select the folder
- Call a number of other macro's to perform functions on the data in the text files
- Save the text files in .xls format with the same filename as the original text file, i.e. a text file named "test1.txt" would be saved as "test1.xls", leaving the original "test1.txt" intact.

To open a user prompt to select the directory I have used a user defined function ("GetDirectory") I found on this website:
http://j-walk.com/ss/excel/tips/tip29.htm

I would like to keep this functionality if possible but if someone has their own way of doing this I'm happy to adopt it. I'd also settle for having to define the specific directory in the macro if it meant it would work!

The code I have so far is as follows:

Sub Toms_Final_Application_INCOMPLETE()
Dim SourceDir As String
Dim fn As String

SourceDir = GetDirectory ("Select folder containing text files")
fn = Dir(SourceDir & "\*.txt")
Do While fn <> ""
Workbooks.OpenText fn, Origin:=437, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:= xlDoubleQuote, onsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Call ClockConvert_ColumnsArrange
Call GetLumenAreas
Call Normalize
Call FinalColumnAdjustments
ActiveWorkbook.SaveAs "", "xlExcel8"
ActiveWorkbook.Close

fn = Dir()
Loop
End Sub

All the macro's that are called work individually. When I run this macro though I get the message:
Run-time error '1004'

'TR1_Control.txt' could not be found. Check the spelling of the file name, and verify the file location is correct.

It doesn't even seem to get as far as opening the first text file. Am I even on the right track with this? Any help would be much appreciated.

Thanks,

Tom

Wow, apologies for the long post!

Welcome to the forum, Tom. :)

Which version of Excel are you using?


Workbooks.OpenText fn

Try including the full path and filename, not just the filename, so that it doesn't rely on the current folder being the one the text file is contained in.

Hi Colin, thanks for your reply. I am using Excel 2007.
I did as you suggested and instead of trying to be too fancy I have specified the folder for "SourceDir" and the whole path when opening and saving the files. The macro seems to almost work now! It opens the first text file in the folder, calls the other macros and they all do what they are supposed to do. It then saves the text file in .xls format, leaving the original text file unchanged and then closes that workbook. My only problem now is that the loop does not function properly. Below is the revised macro, with the line that returns an error highlighted:

Sub Toms_Final_Application_INCOMPLETE()
Dim SourceDir As String
Dim fn As String

SourceDir = "C:\Users\tcarlisl\Desktop\Place chart text files here"
ChDir (SourceDir)
fn = Dir("*.txt")
Do While fn <> ""
Workbooks.OpenText Filename:=SourceDir & "\" & fn, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1)), TrailingMinusNumbers:=True
Call ClockConvert_ColumnsArrange
Call GetLumenAreas
Call Normalize
Call FinalColumnAdjustments
ActiveWorkbook.SaveAs Filename:=SourceDir & "\" & ActiveWorkbook.Name & ".xls", FileFormat:=56
ActiveWindow.Close (False)

fn = Dir() 'This line generates the error message "run-time error 5: invalid procedure call or argument"
Loop
End Sub

I can't figure this out because many examples of loop functions I've seen online seem to use this "* = Dir ()" command to move to the next file. When I comment out that line it doesn't return an error, but the loop just repeats again over the first text file in the folder. Any idea why this is happening? What is excel being told to do with that "* = Dir ()" command issued before the loop command?

Thanks,

Tom

Hi,

Your activeworkbook.name will have the the extension of .txt. Then you are appending .xls on top. You will need to parse out the .txt and the append the .xls.

The actual loop runs fine for me.

Hi ZKat,
Thanks for testing my macro - although I'm even more confused now to hear that it runs fine for you! Are you using Excel 2007 as well?
Regarding the extensions, I tried figuring out how to remove the .txt but I couldn't find a way to do it. It doesn't change the main outcome of the macros so I wasn't going to ask about it on here until my main problem was solved. As you have mentioned it though, can you suggest a method for doing this? I tried a few variations on the "Right" command but wasn't really sure what I was doing.

Tom

I have just registered to he help you out.

You have two options:

1- Select a txt file manually using GetOpenFilename
2- Locate a folder and convert all txt files in it using FileDialog(msoFileDialogFolderPicker)

To use the first one use:
GetOpenFilename(fileFilter:=strFilter, FilterIndex:=bytFilterIndex, Title:=strTitle)

To use the second one use:
' Get folder path
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the folder where you have saved reports from Oracle"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
End If
g_strPath = .SelectedItems(1) & "\"
End With
g_strReport = Dir(g_strPath)

To remove .txt use:

Right(g_strReport, 4)

OK, I figured out why my macro worked for ZKat but not me. It seems when I call the macro "GetLumenAreas" it causes the error I mentioned in my previous post. When it is commented out the whole loop runs fine.

"GetLumenAreas" is also a macro that loops through a series of text files and copies their data into a single workbook in excel and it runs fine on its own. The code is as follows:

Sub GetLumenAreas()
filepath = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select first text file corresponding to lumen areas of " & ActiveWorkbook.Name)

Do While Right(filepath, 1) <> "\"
filepath = Left(filepath, Len(filepath) - 1)
Loop

Dim lumenText As String, txt As String, x

ChDir (filepath)
lumenText = Dir(filepath & "\*.txt")
Do While lumenText <> ""
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(filepath & "\" & lumenText).ReadAll
x = Application.Transpose(Split(txt, vbCrLf))
ActiveSheet.Range("z" & Rows.Count).End(xlUp)(2).Resize(UBound(x, 1)).Value = x
lumenText = Dir()
Loop

Range("Z1").Select
Selection.Delete Shift:=xlUp
Range("Y1").Select
ActiveCell.Formula = "0"
Range("Y2").Select
ActiveCell.Formula = "0.033333"
Range("Y1:Y2").Select
Selection.AutoFill Destination:=Range("Y1:Y8000"), Type:=xlFillDefault

End Sub


Is there a trick to running a loop within a loop? This is the last hurdle in getting this macro running!

Thanks in advance,

Tom

Hi aloobi, thanks for the tip, I am now able to remove the ".txt" from the filenames of my .xls files! I actually used this code in the end as my file names are all of varying lengths:

Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)

Thanks again for getting me started,

Tom

Hi Tom_C

Good job on the extension.

I am confused on the GetLumenAreas - are these the same files you are opening with:
Do while fn <> "" ?

Why not just run the GetLumenAreas separately ?

Hi ZKat, thanks for your help so far.

Its actually a bit complicated. The Do While fn <> "" is acting on one set of text files containing data (data set 1). The GetLumenAreas macro is acting on a different set of text files containing more data (data set 2). Data set 1 and 2 are from different sources but correspond to one another so I would like them in the same workbook for the purposes of analysis. By looping the analysis stage (Do While fn <>"") I've saved myself a lot of time, and I could run the GetLumenAreas macro separately, but I was hoping to be able to automate as much as possible so I don't have to do too much to the data once it is analysed - it would add up to a lot of mouse clicks and I am lazy!

It seems I'm not far off now, but its this last step that is tripping me up. The GetLumenAreas is actually a relatively simple macro that I put together after reading around this forum and others:

Sub GetLumenAreas()
'This section selects the first of the text files to be imported
filepath = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select first text file corresponding to lumen areas of " & ActiveWorkbook.Name)

'This section trims the filepath to just the directory containing the other text files
Do While Right(filepath, 1) <> "\"
filepath = Left(filepath, Len(filepath) - 1)
Loop

'This is the start of the looping section to import all the text files
Dim lumenText As String, txt As String, x

ChDir (filepath)
lumenText = Dir(filepath & "\*.txt")
Do While lumenText <> ""
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(filepath & "\" & lumenText).ReadAll
x = Application.Transpose(Split(txt, vbCrLf))
ActiveSheet.Range("z" & Rows.Count).End(xlUp)(2).Resize(UBound(x, 1)).Value = x
lumenText = Dir()
Loop

'This is faily harmless, just tidying up columns and adding a column to give each data point a corresponding time stamp
Range("Z1").Select
Selection.Delete Shift:=xlUp
Range("Y1").Select
ActiveCell.Formula = "0"
Range("Y2").Select
ActiveCell.Formula = "0.033333"
Range("Y1:Y2").Select
Selection.AutoFill Destination:=Range("Y1:Y8000"), Type:=xlFillDefault

End Sub



I just can't see why its causing a problem as both macro's run fine independently of one another. All I can think is that maybe there is some kind of conflict occurring between the two "Dir" or "Do While" functions? This just goes beyond my current abilities with VBA!

What error are you getting or does it hang?

I notice you are using FSO here, but I do not know why.

Have you stepped through your code (F8) to see where the problem is ?