Search

VBA - Dynamic file selection using File Dialogs and Import Data from selected Excel files

Hello friends,

Please find below the code used in the tutorial

VBA - Dynamic file selection using File Dialogs and Import Data from selected Excel files
If you have any questions please feel free to comment below the video or email me directly at vbaa2z.team@gmail.com and I will try and come back as soon as possible. Please do not forget to leave a like and subscribe to our channel. Thanks for your support.

Click here to Subscribe
Tutorial link: https://www.youtube.com/watch?v=eHuETf6ygto


Option Explicit
Public PriorCalcMode As Variant


'https://docs.microsoft.com/en-us/office/vba/api/office.filedialog
'https://docs.microsoft.com/en-us/office/vba/api/excel.application.filedialog

'MsoFileDialogType can be one of these constants:
'msoFileDialogFilePicker. Allows user to select a file.
'msoFileDialogFolderPicker. Allows user to select a folder.
'msoFileDialogOpen. Allows user to open a file.
'msoFileDialogSaveAs. Allows user to save a file.

Sub select_import_code()

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Dim vfd As Office.FileDialog
Dim vfd_file As Variant
Dim curFileName As String
Dim destination_wb As Workbook

Set vfd = Application.FileDialog(msoFileDialogFilePicker)

With vfd
    .AllowMultiSelect = True
    .InitialFileName = "D:\VBAA2Z Demo\FileDialog\ds files\"
    
    .Filters.Clear
    .Filters.Add "All Files", "*.xls*"
    .Show
    
    Debug.Print .SelectedItems.Count
    
    If .SelectedItems.Count <> 0 Then
    TurnOnSpeed True
    Set destination_wb = Workbooks.Add
    
    For Each vfd_file In .SelectedItems
       Debug.Print Trim(vfd_file)
       curFileName = vfd_file
       Debug.Print "Import status: " & get_data(curFileName, destination_wb)
    Next
    
    Else
    
    MsgBox "File not selected"
    
    End If
    
    
End With

destination_wb.SaveAs "D:\VBAA2Z Demo\FileDialog\ds files\masterWorkbook.xlsx", xlOpenXMLWorkbook

Set destination_wb = Nothing

TurnOnSpeed False
 
End Sub

Function get_data(wb_path$, xWb As Workbook) As Boolean

    Dim dslr As Long, new_lr As Long, paste_des_row As Long
    Dim copyrange As Range
    Dim tagRng As Range
    Dim headerCopiedCnt As Long
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(wb_path, False, True)
    
    With wb
        dslr = .Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
        
        If headerCopiedCnt = 0 Then
          Set copyrange = .Sheets(2).Range("A1:K" & dslr)
          headerCopiedCnt = headerCopiedCnt + 1
          Else
          Set copyrange = .Sheets(2).Range("A2:K" & dslr)
        End If
        copyrange.Copy
    End With
    
    
    With xWb
        
        
        
        paste_des_row = .Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
        
        
        .Sheets(1).Range("B" & paste_des_row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        
        new_lr = .Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
        
        Set tagRng = .Sheets(1).Range(Range(Cells(paste_des_row, 1), Cells(new_lr, 1)).Address)
        tagRng.Value = wb.Name
        Application.CutCopyMode = False
        Set tagRng = Nothing
        
    End With
    
    Set copyrange = Nothing
    wb.Close False
    Set wb = Nothing
    get_data = True
    
End Function




Public Function TurnOnSpeed(x As Boolean)
    If x = True Then
    With Application
        PriorCalcMode = Application.Calculation
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Cursor = xlWait
            .Calculation = xlCalculationManual
    End With
    
    ElseIf x = False Then
    
    With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
            .EnableEvents = True
            .StatusBar = False
            .Cursor = xlDefault
        .Calculation = PriorCalcMode
        End With
    End If

End Function



Labels: ,