New Excel Forum

This forum has been moved to TeachExcel.

Ask all future questions in the new excel forum.

ExcelKey

Select Workbooks To Extract Data From

Free Excel Macros
Forum rules
This forum is closed.

All new posts should be made at our new Excel Forum at TeachExcel.com.

Select Workbooks To Extract Data From

Postby Sisyphus » Thu Nov 08, 2012 5:30 am

Here is another approach to loop through several workbooks (look for the topic "Loop through several workbooks" on this forum). The user can select any number of workbooks from a normal File Open dialog box. Each workbook will be opened in turn. It will then be possible to either extract data from them or write data into them. For this purpose the workbook that contains the code is declared in the code and can be referenced by the assigned name (WbT).
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.
Have a great day! :D

Sisyphus
I do this for "honour and country" - much less of the latter, actually.
If I helped you, award points, plenty of them.
If I bored you, deduct points for being too long-winded. (I know, :lol)
Sisyphus
Former Moderator
 
Posts: 4454
Joined: Dec 7, 2011
Location: Shanghai
Reputation: 203
Excel Version: 2010

Return to Excel Macros

Who is online

Users browsing this forum: No registered users and 1 guest