- Code: Select all
Option Explicit
Public Sub ImportData()
Dim WbT As Workbook ' Target
Dim WbS As Workbook ' Source
Dim Fn() As String
Dim WasClosed As Boolean
Dim F As Integer
If GetFileNames(Fn) = 0 Then Exit Sub
Set WbT = ThisWorkbook
' Application.ScreenUpdating = False
' If you set Application.ScreenUpdating = False
' the opened workbooks will remain invisible
For F = 1 To UBound(Fn)
Set WbS = SetSourceBook(Fn(F), WasClosed)
' do with the open workbook whatever you want
MsgBox "Currently selected workbook is" & vbCr _
& WbS.Name, vbInformation, "Current workbook's name"
If WasClosed Then WbS.Close SaveChanges:=False
' If the workbook wasn't closed before, don't close it now
Next F
Application.ScreenUpdating = True
End Sub
Private Function GetFileNames(ByRef Fn() As String) As Long
' get the names of all workbooks to be opened
Dim i As Long
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select workbooks for input"
.Filters.Clear
.Filters.Add "Excel workbooks (*.xls, *.xlsx)", "*.xls, *.xlsx"
.AllowMultiSelect = True ' False to allow only a single selection
.Show
For i = 1 To .SelectedItems.Count
ReDim Preserve Fn(i)
Fn(i) = .SelectedItems(i)
Next i
End With
On Error Resume Next
GetFileNames = UBound(Fn)
End Function
Private Function SetSourceBook(ByVal Ffn As String, _
ByRef WasClosed As Boolean) _
As Workbook
' open workbook Ffn (FullFileName) as Read Only
' and remember that it was closed
' If the book is already open identify it
' Either way return the workbook object
Dim Fn() As String
Fn = Split(Ffn, "\")
On Error Resume Next
Set SetSourceBook = Workbooks(Fn(UBound(Fn)))
If Err Then
Set SetSourceBook = Workbooks.Open(Ffn, ReadOnly:=True)
WasClosed = True
End If
End Function
Paste the above code into a normal code module and call the procedure ImportData from the Macro list available on the Developer tab under Macros.