MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Vba For Next Loop

Posted by Hal Turchin on November 03, 2000 11:56 AM

I have 7 individual Excel workbooks that I want to open, perform some formatting, then save and close each workbook.
My problem is that I'm very new at Vba.

I would think that a For Next Loop might be the answer, but I don't know exactly how to write it.

Any help would be greatly appreciated.



Posted by Ivan Moala on November 05, 2000 12:33 AM

Hal, here is a routine that while not exactly what
you want (it finds text files and changes them
then saves it as an xls file) you can get what
you need out of it......if you want further info
then email me........

Dim x As Integer
Dim temp
Dim i As Integer
Dim Drive As String
Dim Filename 'Must be a variant !!
Dim Filetype As String 'eg. *.txt , *.xls etc
Dim ChFiles() As String 'Array that contains FileName to change
Dim DirSave As String 'Dir where you want to save in
Dim FFiles As Integer
Dim WB As Integer

Sub Version1()
Drive = "A:\" 'Change this for another drive
Filetype = "*.txt" 'Change this to suit
DirSave = "C:\" 'Dir where you want to save in

With Application.FileSearch
.LookIn = Drive
.SearchSubFolders = False
.Filename = Filetype
.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
'Store filename in array
ChFiles(i) = Right(.FoundFiles(i), Len(.FoundFiles(i)) - x + 1)
End If

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

'Now open all files in array
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:=DirSave & Left(ChFiles(WB), Len(ChFiles(WB)) - 3) & "xls"
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
MsgBox "Completed!"
Exit Sub
If Err.Number <> 1004 Then
MsgBox Err.Number & " :=" & Err.Description
Resume Next
End If

End Sub