Load ListBox through MFDialogboxFolder

[sunilbsrv2k]

Hi All,

I am trying to load a listbox through MFDialogbox Picker.

Unfortunately, its not working. Request your help.

Below is the code, I am using. Thanks

Private Sub UserForm_Initialize()
Dim myfiles As String, mypath As String
Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    mypath = .SelectedItems(1)
    DoEvents
End With
MsgBox mypath
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
ReDim fileList(1 To I)
fName = Dir(mypath)
MsgBox fName
    While fName <> ""
         'add fName to the list
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
         'get next filename
        fName = Dir()
    Wend
     'see if any files were found
    If I = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
     'cycle through the list and add to listbox
    For I = 1 To UBound(fileList)
        Me.ListBox1.AddItem fileList(I)
    Next

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Private Sub UserForm_Initialize()
Dim myfiles As String, mypath As String
Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    mypath = .SelectedItems(1)
    DoEvents
End With
'MsgBox mypath
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
fName = Dir(mypath)
'MsgBox fName
    While fName <> ""
         'add fName to the list
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
         'get next filename
        fName = Dir()
    Wend
     'see if any files were found
    If I = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
    Me.ListBox1.List = fileList

End Sub

 

[sunilbsrv2k]

Hi & welcome to MrExcel.
How about

Private Sub UserForm_Initialize()
Dim myfiles As String, mypath As String
Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    mypath = .SelectedItems(1)
    DoEvents
End With
'MsgBox mypath
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
fName = Dir(mypath)
'MsgBox fName
    While fName <> ""
         'add fName to the list
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
         'get next filename
        fName = Dir()
    Wend
     'see if any files were found
    If I = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
    Me.ListBox1.List = fileList

End Sub

Hi Fluff,

Thanks for your help.

This works fine .

Could you please let me know, where I went wrong?

Also, can this be further modified to open the respective file in the list?

Thanks

 

[Fluff]

The problem was with the line in red

If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
[COLOR=#ff0000]ReDim fileList(1 To I)[/COLOR]
fName = Dir(mypath)

at that point I did not have a value, so you were effectively trying to dim Filelist(1 to 0)

If your listbox is single select try

Option Explicit
Dim mypath As String
Private Sub ListBox1_Click()
Workbooks.Open (mypath & Me.ListBox1.Value)
End Sub
Private Sub UserForm_Initialize()
Dim myfiles As String
Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    mypath = .SelectedItems(1)
    DoEvents
End With
'MsgBox mypath
If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
fName = Dir(mypath)
'MsgBox fName
    While fName <> ""
         'add fName to the list
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
         'get next filename
        fName = Dir()
    Wend
     'see if any files were found
    If I = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
    Me.ListBox1.List = fileList

End Sub

 

[sunilbsrv2k]

Thank you so much... this works very fine for me.

However, the file that will be opened from Listbox is not responding... I guess because the Userform is still open....

Can this be rectified?

Also, this was a part of my task which was originally to select the PDF files in one Listbox to second Listbox... [This task is coded and working fine]

I found a code to merge PDFs... even that is working fine for me.

Now, the task for me is to merge PDFs in second Listbox using the Program to merge PDFs.

 

[Fluff]

In Userform properties change ShowModal to False

 

[sunilbsrv2k]

Hi Thanks... Its working fine.

As this was a part of a bigger project... I am confused while trying to use this code, as mentioned previously, in a PDf merger program.

Sub Main()
   
    Const DestFile As String = "MergedFile.pdf" ' <-- change to suit
   
    Dim MyPath As String, MyFiles As String
    Dim a() As String, i As Long, f As String
   
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With
   
      ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    ReDim a(1 To 2 ^ 14)
    f = Dir(MyPath & "*.pdf")
    While Len(f)
        If StrComp(f, DestFile, vbTextCompare) Then
            i = i + 1
            a(i) = f
        End If
        f = Dir()
    Wend
   
    ' Merge PDFs
    If i Then
        ReDim Preserve a(1 To i)
        MyFiles = Join(a, ",")
        Application.StatusBar = "Merging, please wait ..."
        Call MergePDFs(MyPath, MyFiles, DestFile)
        Application.StatusBar = False
    Else
        MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If
   
End Sub

Above is the code from which PDF merger is called.

But, I want the Main program to take the files from the above list box and in the same order as displayed in the list box.

Is this a possibility? I am trying to implement but getting confused