- Code: Select all
Option Explicit
Public Sub LoopThruWorkbooks()
' Specify the folder where your files are located
' make sure FilePath ends with a path separator
Const FilePath As String = "D:\My Documents\For Reference Only\ExcelKey\"
' enter each file name between quotation marks
' you can add as many as you like
' all names excepting the first must be preceded by a backslash
' and must include the extension
Const FileNames As String = "120129 Club Inventory.xls" & _
"\File 2.xlsx" & _
"\File 3.xlsm" & _
"\File 4.xlst"
Dim Wb As Workbook
Dim Ffn() As String
Dim Fn As String
Dim i As Integer
Dim WasOpen As Boolean
Application.ScreenUpdating = False
Ffn = Split(FileNames, "\")
For i = LBound(Ffn) To UBound(Ffn)
Fn = FilePath & Trim(Ffn(i))
If Len(Dir(Fn)) Then
With Workbooks
On Error Resume Next
Set Wb = .Item(Ffn(i))
WasOpen = Not CBool(Err)
If Not WasOpen Then
Set Wb = .Open(Fn, ReadOnly:=True)
End If
On Error GoTo 0
End With
' this message box is for demonstration only
' It may be deleted when no longer required
MsgBox "File '" & Ffn(i) & "' is now open." & vbCr & _
"Data can be extracted using VBA" & vbCr & _
"before closing the book automatically."
' Extract whatever data you want here
If Not WasOpen Then Wb.Close SaveChanges:=False
Else
If MsgBox("The workbook '" & Ffn(i) & "' wasn't found." & vbCr & _
"Check the spelling of the file name, that" & vbCr & _
"the file exists in the specified directory," & vbCr & _
"and that it is of " & Extension(Ffn(i)) & " type.", _
vbOKCancel, "Specified workbook not found") = vbCancel Then
Exit For
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
Private Function Extension(ByRef Fn As String) As String
Dim Sp() As String
Sp = Split(Fn, ".")
Extension = UCase(Sp(UBound(Sp)))
End Function
You must set the constants PathName and FileNames. Follow the instructions contained in the remarks.
Note that any workbook found already open will be processed as required by the code you add but will not be closed by the above code.