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.
Thanks,
Hal
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
.NewSearch
.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
Wend
'Store filename in array
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
'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
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
