MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Opening all text files and saving as .xls


Posted by Ben on August 19, 2000 10:29 PM

I'm trying to write a macro that opens all text files that are on a floppy and then saves them to the hard drive as .xls files.
I've been using this:
Sub OpenFiles()
NextFile = Dir("A:\*.*", vbNormal)
Do While NextFile <> ""
Workbooks.OpenText FileName:=NextFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2 _
), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1))
newname = ActiveWorkbook.Name
ActiveWorkbook.SaveAs FileName:="C:\\" & newname & ".xls"
NextFile = Dir
Loop

... but the sub only opens the files about 1/2 of the time (Error -- "cannot find the file"). Tried opening Excel with /regserver switch for long filenames -- no luck.
(As for the SaveAs part, the files are saved as .txt.xls. Any way to remove the .txt?)

Any help would be appreciated. Thanks.


Posted by Ivan Moala on August 20, 0100 12:17 AM


Try setting your default drive to your working drive and the following admend below.

Sub openfiles()

'Get current Dir
OldDir = CurDir
'Now change default Dir
ChDir "A:\"

NextFile = Dir("A:\*.*", vbNormal)
Do While NextFile <> ""
Workbooks.OpenText FileName:=NextFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2 _
), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1))

newname = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
ActiveWorkbook.SaveAs FileName:="C:\" & newname & ".xls"
NextFile = Dir
Loop

'Restore back to old directory
ChDir OldDir
End Sub


HTH


Ivan

Posted by Ivan Moala on September 04, 0100 3:14 AM

Ben
Sorry......tested now try this ???

Dim x As Integer
Dim temp
Dim i As Integer
Dim Drive As String
Dim Filename 'Must be a variant !!
Dim ChFiles() As String
Dim FFiles As Integer
Dim WB As Integer

Sub Version2()
'---------------------
Drive = "A:\" 'Change this for another drive
'----------------------

With Application.FileSearch
.NewSearch
.LookIn = Drive
.SearchSubFolders = False
.Filename = "*.txt"
.MatchTextExactly = True
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
ReDim ChFiles(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
'Get Filename only
x = 1
While InStr(x, .FoundFiles(i), "\") <> 0
temp = InStr(x, .FoundFiles(i), "\")
x = x + 1
Wend
ChFiles(i) = Right(.FoundFiles(i), Len(.FoundFiles(i)) - x + 1)
Next
End If

If .FoundFiles.Count = 0 Then MsgBox "No Text files in " & Drive: End
End With
'---------------------------------------------------------------------
On Error GoTo ErrH
Application.ScreenUpdating = False

For WB = 1 To UBound(ChFiles())
Workbooks.OpenText Drive & ChFiles(WB), Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2), _
Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1))

ActiveWorkbook.SaveAs Filename:="C:\" & Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls"
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
MsgBox "Completed!"
Exit Sub
ErrH:
If Err.Number <> 1004 Then
MsgBox Err.Number & " :=" & Err.Description
Else
Resume Next
End If

End Sub


Ivan

Posted by Ben on August 20, 0100 10:08 AM

HTH Ivan

Thanks Ivan, but Excel still doesn't like NextFile = Dir("A:\*.*", vbNormal). It will open the files some of the time. If I change NextFile to ("A:\*.*") then the first file always opens but, of course, it tries to open the same file over & over. Any more thoughts?

Posted by Ben on September 02, 0100 12:53 PM


Thanks Ivan. I tried that. VB opens the first file but won't open the rest.

Posted by Ivan Moala on August 26, 0100 5:11 PM

Thanks Ivan, but now I get a "The file could not be accessed" error.


Ben, not tested but put this in

ChDir "A:\" after ActiveWorkbook.Close


Ivan


Posted by Francisco J. Estaba S. on August 20, 0100 5:24 PM

Need Help Again with Dates (CELIA, Please HELP!)

Posted by Francisco J. Estaba S. on August 20, 0100 5:32 PM

Need Help Again with Dates (CELIA, Please HELP!)

Hi, as i stated before, i´m a Judge in Venezuela who is confronting problems creating a Worksheet to calculate times of conviction.
Celia has helped Before, but as i was creating the Worksheet i discovered that then i had to introduce the time of the imprinsonment (?) as follows:
Years Months Days Hours Minutes
1 5 22 2 30

Then i have to add that much time to a "given" date as 22/8/00
Also, i have to take 2/3, 1/3, 1/2, 1/4 to the initial amount of years, months days, hours and minutes and add it too to the second date, that is the day the convict initiates his conviction.
Problems is that this is not all. I also have to calculate the amount of time elapsed since the initial detention of the convict to the day of today, and that date becomes the "given" date i mentioned before...
ARGH!

Posted by Ben on August 21, 0100 5:46 PM

YOU COULD TRY SOMETHING DIFF, Option Explicit Dim i As Integer Dim Drive As String Dim Filename 'Must be a variant !! Dim ChFiles() As String Dim FFiles As Integer Dim WB As Integer Sub Version1() '--------------------- Drive = "A:\" '---------------------- With Application.FileSearch .NewSearch .LookIn = Drive .SearchSubFolders = False .Filename = "*.txt" .MatchTextExactly = True .MatchAllWordForms = True .FileType = msoFileTypeAllFiles If .Execute() > 0 Then ReDim ChFiles(.FoundFiles.Count) For i = 1 To .FoundFiles.Count ChFiles(i) = .FoundFiles(i) Next End If If .FoundFiles.Count = 0 Then MsgBox "No Text files in " & Drive: End End With '--------------------------------------------------------------------- On Error GoTo ErrH Application.ScreenUpdating = False For WB = 1 To UBound(ChFiles()) Workbooks.OpenText ChFiles(WB), Origin:=xlWindows, _ StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _ , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2), _ Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1)) ActiveWorkbook.SaveAs Filename:=Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls" ActiveWorkbook.Saved = True ActiveWorkbook.Close Next Application.ScreenUpdating = True MsgBox "Completed!" Exit Sub ErrH: If Err.Number <> 1004 Then MsgBox Err.Number & " :=" & Err.Description Else Resume Next End If End Sub NB: Not tested ! Ivan

Thanks Ivan, it's opening all text files on the floppy just great. Now, how do I get it to save files to the C:\ drive?

Posted by Ben on August 20, 0100 7:22 PM

HTH Ivan

Ivan, I seem to have a glitch in vb. I can run some subs in one module but not in others. For example, I can run x = GetFileList("A:\") in one module but get the error "Sub or function not defined in another." I reinstalled Excel but no change.

Posted by Ben on August 20, 0100 8:26 PM

Ignore the "alxo" message

Sorry, the function was missing from the other project.

Posted by Ivan Moala on August 21, 0100 9:01 PM

YOU COULD TRY SOMETHING DIFF, Option Explicit Dim i As Integer : Dim Drive As String : Dim Filename 'Must be a variant !! : Dim ChFiles() As String : Dim FFiles As Integer : Dim WB As Integer Sub Version1() : '--------------------- : Drive = "A:\" : '---------------------- With Application.FileSearch : .NewSearch : .LookIn = Drive : .SearchSubFolders = False : .Filename = "*.txt" : .MatchTextExactly = True : .MatchAllWordForms = True : .FileType = msoFileTypeAllFiles : If .Execute() > 0 Then : ReDim ChFiles(.FoundFiles.Count) : For i = 1 To .FoundFiles.Count : ChFiles(i) = .FoundFiles(i) : Next : End If : If .FoundFiles.Count = 0 Then MsgBox "No Text files in " & Drive: End : End With : '--------------------------------------------------------------------- : On Error GoTo ErrH : Application.ScreenUpdating = False For WB = 1 To UBound(ChFiles()) : Workbooks.OpenText ChFiles(WB), Origin:=xlWindows, _ : StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ : ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _ : , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2), _ : Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1)) ActiveWorkbook.SaveAs Filename:=Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls" : ActiveWorkbook.Saved = True : ActiveWorkbook.Close : Next : Application.ScreenUpdating = True : MsgBox "Completed!" : Exit Sub : ErrH


Woops, sorry forgot about that, in that it is
saving to the A:\

Just change;
ActiveWorkbook.SaveAs Filename:=Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls"

TO;

ActiveWorkbook.SaveAs Filename:= "C:\" & Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls"


Ivan

Posted by Ivan Moala on August 20, 0100 9:20 PM

Thanks Ivan, but Excel still doesn't like NextFile = Dir("A:\*.*", vbNormal). It will open the files some of the time. If I change NextFile to ("A:\*.*") then the first file always opens but, of course, it tries to open the same file over & over. Any more thoughts?

YOU COULD TRY SOMETHING DIFF,

Option Explicit

Dim i As Integer
Dim Drive As String
Dim Filename 'Must be a variant !!
Dim ChFiles() As String
Dim FFiles As Integer
Dim WB As Integer

Sub Version1()
'---------------------
Drive = "A:\"
'----------------------

With Application.FileSearch
.NewSearch
.LookIn = Drive
.SearchSubFolders = False
.Filename = "*.txt"
.MatchTextExactly = True
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
ReDim ChFiles(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
ChFiles(i) = .FoundFiles(i)
Next
End If
If .FoundFiles.Count = 0 Then MsgBox "No Text files in " & Drive: End
End With
'---------------------------------------------------------------------
On Error GoTo ErrH
Application.ScreenUpdating = False

For WB = 1 To UBound(ChFiles())
Workbooks.OpenText ChFiles(WB), Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 2), _
Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), Array(6, 1))

ActiveWorkbook.SaveAs Filename:=Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls"
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
MsgBox "Completed!"
Exit Sub
ErrH:
If Err.Number <> 1004 Then
MsgBox Err.Number & " :=" & Err.Description
Else
Resume Next
End If

End Sub


NB: Not tested !


Ivan

Posted by Ben on August 21, 0100 11:32 PM

YOU COULD TRY SOMETHING DIFF, : Option Explicit : Dim i As Integer

Thanks Ivan, but now I get a "The file could not be accessed" error.