Sub BatchProcess()
Dim Files() As String
Dim FileSpec As String
FileSpec = "c:\text.txt"
NewPath = ExtractPath(FileSpec)
FoundFile = Dir(FileSpec)
If FoundFile = "" Then
MsgBox "Cannot find file:" & FileSpec
Exit Sub
End If
FileCount = 1
ReDim Preserve Files(FileCount)
Files(FileCount) = FoundFile
Do While FoundFile <> ""
FoundFile = Dir()
If FoundFile <> "" Then
FileCount = FileCount + 1
ReDim Preserve Files(FileCount)
Files(FileCount) = FoundFile
End If
Loop
For I = 1 To FileCount
Application.StatusBar = "Processing " & Files(I)
Call ProcessFiles(Files(I))
Next I
Application.StatusBar = False
End Sub
Sub ProcessFiles(FileName As String)
Workbooks.OpenText FileName:=FileName, Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, 1), Array(12, 1))
End Sub
Function ExtractPath(Spec As String) As String
SpecLen = Len(Spec)
For I = SpecLen To 1 Step -1
If Mid(Spec, I, 1) = "\" Then
ExtractPath = Left(Spec, I - 1)
Exit Function
End If
Next I
ExtractPath = ""
End Function
|