Common Dialog (Multiple Selection)

[D Willett]

Hi.

(as a previous post I have to change code im my project )

My code for the common dialog needs a change.
On single file selection my listbox.additem adds the file with its full path which is how I require it to work now.

On multiple selection the path is stripped away and just the filename added to the list instead.
This was fine before but it now causes an issue with using a different viewing control.
Can anyone help with this so the multiple file selection populates the list with full path and filename?

Code: Select all

Private Sub procDocOther_Click(Index As Integer)
    On Error GoTo cError

    Dim i      As Integer
    Dim myFiles() As String
    Dim myPath As String
    CmnDialog1.FileName = ""

    If Me.txtEst = "" Then
        MsgBox "Please Enter The Job Number in The Main View", vbInformation, "Document Import"
        Exit Sub
    End If

 
    With CmnDialog1
        .MaxFileSize = 32000   'this will max out the buffer for the filenames array for large selections. *NEW*
        .CancelError = False   'if cancel is pressed, the code jumps to cError because of the On Error statement above

        .Filter = "PDF Files|*.pdf"
        .FilterIndex = 2
        .InitDir = ""
        .Flags = CD_FLAGS   'this is where we tell it to use multiselect
        .ShowOpen

        myFiles = Split(.FileName, vbNullChar)   'the Filename returned is delimeted by a null character because we selected the cdlOFNLongNames flag

        Select Case UBound(myFiles)
            Case 0    'if only one was selected we are done
                Dim strFile As String
                Dim intPos As Integer
                ' Get filename with path
                strFile = myFiles(0)
                frmDocImport.Show
                frmDocImport.txtPath = CmnDialog1.FileName
                frmDocImport.txtDocEst = Me.txtEst
                frmDocImport.lstFiles.AddItem strFile
                frmDocImport.WebBrowser1.Navigate2 CmnDialog1.FileName

            Case Is > 0    'if more than one, we need to loop through it and append the root directory
                
                frmDocImport.Show
                frmDocImport.txtPath = CmnDialog1.FileName
                frmDocImport.txtDocEst = Me.txtEst
                For i = 1 To UBound(myFiles)
                frmDocImport.lstFiles.AddItem myFiles(i)
                frmDocImport.WebBrowser1.Navigate2 CmnDialog1.FileName
                

                Next i
        End Select
        CmnDialog1.FileName = ""
    End With

    Exit Sub

cError:
    Beep
    MsgBox Err.Description   '*NEW*


End Sub

[Rudi]

Hi Dave,

I cannot open the zip and test as I do not have VB on my PC, but see if the sample files help. They seem to refer to retaining the full path of the selected files.
See this page and the zip attachment: http://www.freevbcode.com/ShowCode.asp?ID=2771

[HansV]

Hi Dave,

Are you using the common dialog in an Office application, or in VB6? The Office applications nowadays have their own, very convenient implementation of the common dialog: Application.FileDialog.

[D Willett]

Hi Hans. I've changed quite alot of code (VB6) because of major issues with Adobe, the acroPDF.dll file has now been issued as 64bit and the 32bit discontinued, there is no resolve to this. However, using the WebBrowser control I can reproduce the same visual application and the user does'nt even know about it.
There are many changes which I have done successfully but one or two little bits are niggling me..
So, going back to the original code for the file dialog to try and attempt to fix this.

On form form1024Image, the cmnDialog code is:

Code: Select all

Private Sub procDocOther_Click(Index As Integer)
    On Error GoTo cError

    Dim i      As Integer
    Dim myFiles() As String
    Dim myPath As String
    
    
    
    CmnDialog1.FileName = ""

    If Me.txtEST = "" Then
    MsgBox "Please Enter The Job Number in The Main View", vbInformation, "Document Import"
    Exit Sub
    End If
    
    'MsgBox "This Update Allows You To Select Multiple Documents." & vbCrLf & _
    '       "From Your Scanned Folder." & vbCrLf & vbCrLf & _
    '       "Please Select As Many Documents As Required Next." & vbCrLf & vbCrLf & _
    '       "You May Have To Point This Application" & vbCrLf & _
    '       "To Where Your Scanned Documents Are Situated." & vbCrLf & _
    '       "Usually The Location Is Saved For Any Future Imports." & vbCrLf & vbCrLf & _
    '       "If You Have Selected The Wrong Document" & vbCrLf & _
    '       "Use The Cancel Button and Remake Your Selection", vbInformation, "Document Import"

    With CmnDialog1
        .MaxFileSize = 32000   'this will max out the buffer for the filenames array for large selections. *NEW*
        .CancelError = False   'if cancel is pressed, the code jumps to cError because of the On Error statement above

        .Filter = "PDF Files|*.pdf"
        .FilterIndex = 2
        .InitDir = ""
        .Flags = CD_FLAGS   'this is where we tell it to use multiselect
        .ShowOpen

        myFiles = Split(.FileName, vbNullChar)   'the Filename returned is delimeted by a null character because we selected the cdlOFNLongNames flag

        Select Case UBound(myFiles)
        Case 0   'if only one was selected we are done
                Dim strFile As String
                Dim intPos As Integer
                ' Get filename with path
                strFile = myFiles(0)
                ' Get position of last backslash
                intPos = InStrRev(strFile, "\")
                ' Extract part after last backslash, i.e. the filename
                strFile = Mid(strFile, intPos + 1)
                ' Add the filename
                frmDocImport.Show
                frmDocImport.txtDocEst = Me.txtEST
                'frmDocImport.lstFiles.AddItem myFiles(0)
                frmDocImport.lstFiles.AddItem strFile
                
       Case Is > 0   'if more than one, we need to loop through it and append the root directory
            
                frmDocImport.Show
                frmDocImport.txtDocEst = Me.txtEST
                For i = 1 To UBound(myFiles)
                    'myPath = myFiles(0) & IIf(Right(myFiles(0), 1) <> "\", "\", "") & myFiles(i)
                    'frmDocImport.lstFiles.AddItem myPath
                    frmDocImport.lstFiles.AddItem myFiles(i)

                Next i
        End Select
        CmnDialog1.FileName = ""
    End With
    
    Exit Sub

cError:
    Beep
    MsgBox Err.Description   '*NEW*


End Sub

On Form frmDocImport, this code did work using the pdf control. (it has no path and only the filename) the listbox click event, the loadfile event works and opens the document in the pdf control:

Code1:

Code: Select all

Private Sub lstFiles_Click()
Me.txtAcrobatPath = Me.lstFiles
Me.pdfDoc.LoadFile Me.txtAcrobatPath
End Sub

This is the changed code, notice only one line has changed but it won't work as (as before ) it has no path and doesn't load in the WebBrowser control which I can understand.

Code 2:

Code: Select all

Private Sub lstFiles_Click()
Me.txtAcrobatPath = Me.lstFiles
Me.WebBrowser1.Navigate2 Me.txtAcrobatPath
End Sub

It makes no logical sense for code1 to work, it has never thrown an issue until now when I have ridded the project of the pdf control and replaced it with a WebBrowser instead.

[HansV]

Try uncommenting the lines

Code: Select all

                    'myPath = myFiles(0) & IIf(Right(myFiles(0), 1) <> "\", "\", "") & myFiles(i)
                    'frmDocImport.lstFiles.AddItem myPath

and commenting out the next line

Code: Select all

                    frmDocImport.lstFiles.AddItem myFiles(i)

in procDocOther_Click.

[D Willett]

Yes that works..... under my nose all the time. I just have an error 70 later in the code which I'm sure won't be too much of an issue...

Thanks again Hans, really appreciated.

(Oh and thanks for the link Rudi, very helpful.)