VBA to select multiple File and paste fileName in Range

[Mallesh23]

Hi Team,
<strike></strike>
I am unable to paste multiple file name in range("b5") through MSOFileDialogPicker.
below are my code. its only pasting single file name instead of all files.plz assist.

Option Explicit

Sub SelectSeveralFiles()

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim i As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "E:\Pivot\mallesh"
fd.InitialView = msoFileDialogViewList
'allow multiple file selection
fd.AllowMultiSelect = True
FileChosen = fd.Show
If FileChosen = -1 Then
FileName = fd.SelectedItems.Count
Range("b5").Value = FileName
'open each of the files chosen
'For i = 1 To fd.SelectedItems.Count
'Range("b5").Value = fd.SelectedItems(i)
''Workbooks.Open fd.SelectedItems(i)
'Next i
End If
End Sub
<strike></strike>

Thanks
Mallesh

 

[AlphaFrog]

Sub SelectSeveralFiles()
    Dim fd        As FileDialog
    Dim strFiles  As String
    Dim i         As Integer
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.InitialstrFiles = "E:\Pivot\mallesh"
    fd.InitialView = msoFileDialogViewList
    'allow multiple file selection
    fd.AllowMultiSelect = True
    FileChosen = fd.Show
    With ActiveSheet
        If fd.SelectedItems.Count Then
            For i = 1 To fd.SelectedItems.Count
                If strFiles = "" Then strFiles = fd.SelectedItems(i) Else strFiles = strFiles & vbLf & fd.SelectedItems(i)
                'open each of the files chosen
                'Workbooks.Open fd.SelectedItems(i)
            Next i
            .Range("B5").Value = strFiles
        End If
    End With
End Sub

 

[Mallesh23]

Hi Alpha,

Thanks, it worked! now I want to consolidated the file.But
'getting error run time error Method Get 'GetOpenFileName of object_application failed. at below line.

fList = Application.GetOpenFilename(Sheet1.Range("b5").Value, MultiSelect:=True)

Sub test2()
Dim fList, f
Dim wbk As Workbook
Dim wsn
Dim wsCount As Long
Dim i As Long

fList = Application.GetOpenFilename(Sheet1.Range("b5").Value, MultiSelect:=True)

' FileFilter:="Excel Book ,*.xlsx", MultiSelect:=True)
' If Not IsArray(fList) Then Exit Sub<strike></strike>

<strike></strike>

Regards,
Mallesh

 

[AlphaFrog]

I want to consolidated the file.

If you have Excel 2010 or later, you could use the built-in Consolidation feature.
How to consolidate data in Excel using Data Consolidation


If you have Excel 2007 or earlier, here is a free Excel add-in that will consolidate files...
RDBMerge, Excel Merge Add-in



VBA Code: Consolidating Data from Multiple Worksheets into a Summary Worksheet in Excel

 

[zeromax1]

Hi AlphaFrog, I cited your code then made some amendments. I want to pick up the select files then list their path and details in the excel. Could you help me to improve it? thank you very much.

Sub Getfiledetails()

Dim range As range
Dim myfolder As Object
Dim myfiledialog As FileDialog
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.file
Dim i As Integer
Dim nextRow As Long

Set myfiledialog = Application.FileDialog(msoFileDialogFilePicker)
myfiledialog.AllowMultiSelect = True

On Error Resume Next
If myfiledialog.Show = -1 Then

ThisWorkbook.Worksheets(1).Cells(3, 2).Value = myfiledialog.SelectedItems(i)

End If

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(ThisWorkbook.Worksheets(1).Cells(3, 2).Value)

nextRow = Cells(Rows.Count, 2).End(xlUp).Row + 1

For i = LBound(objFile) To UBound(objFile)

    ThisWorkbook.Worksheets(1).Cells(nextRow, 2) = i.Name
    ThisWorkbook.Worksheets(1).Cells(nextRow, 3) = i.Path
    ThisWorkbook.Worksheets(1).Cells(nextRow, 4) = i.Type
    ThisWorkbook.Worksheets(1).Cells(nextRow, 5) = i.DateCreated
    nextRow = nextRow + 1

Next i

Next
End Sub