The User Would Like to Select Multiple PDF Files at Once from The File Dialog Box

gdunn59
gdunn59 used Ask the Experts™
on
I have the following VBA Code that allows the user to select 1 file at a time from the File Dialog Box.

The user would like to select more than one file at a time from the File Dialog Box.

How can that be done?

I have the AllowMultiSelect = True, but I need to know how to get it to work with selecting more than 1 file at a time.

Function AddFile() As LongPtr
  On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim strFileText As String
  Dim strFileName As String
  
  With Application.FileDialog(msoFileDialogOpen)
       .AllowMultiSelect = True
       .Filters.Clear
       .Filters.Add "PDFs", "*.PDF"
       .Show
       strFilePath = .SelectedItems(1)
  End With
  
  If strFilePath = "" Then Exit Function
  
  If GetRecordCount("SELECT * FROM FILE_LIST WHERE FILE_PATH =" & Chr(34) & strFilePath & Chr(34)) > 0 Then
    err.Raise -666, , "This File is Already Loaded!"
  End If

  strFileName = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "\"))
  strFileText = GetFileText(strFilePath)

  AddFile = AddToFileList(strFilePath, strFileName, strFileText)
  If AddFile <> 0 Then Exit Function
  Me.lstFiles.Requery
  
  Me.lblFileList.Caption = GetRecordCount("FILE_LIST") & " Files"
  Me.lstFiles = Me.lstFiles.ItemData(Me.lstFiles.ListCount - 1) 'should always be at least one
  Call lstFiles_AfterUpdate

  Me.cmdParseBMPs.Enabled = True
 
ErrHandler:
  DoCmd.SetWarnings True
  AddFile = ErrorHandler(err, "AddFile")
End Function

Open in new window


Thanks,
gdunn59
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Rey Obrero (Capricorn1)
Top Expert 2016

Commented:
test this 
Function AddFile() As LongPtr
  On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim strFileText As String
  Dim strFileName As String
  Dim j As Integer
  With Application.FileDialog(msoFileDialogOpen)
       .AllowMultiSelect = True
       .Filters.Clear
       .Filters.Add "PDFs", "*.PDF"
  End With
  
   
  With Application.FileDialog(msoFileDialogOpen)
  If .Show Then
    For j = 1 To .SelectedItems.Count
    
          strFilePath = .SelectedItems(j)
          
          If GetRecordCount("SELECT * FROM FILE_LIST WHERE FILE_PATH =" & Chr(34) & strFilePath & Chr(34)) > 0 Then
            Err.Raise -666, , "This File is Already Loaded!"
          End If
        
          strFileName = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "\"))
          strFileText = GetFileText(strFilePath)
        
          AddFile = AddToFileList(strFilePath, strFileName, strFileText)
          If AddFile <> 0 Then Exit Function
          Me.lstFiles.Requery
          
          Me.lblFileList.Caption = GetRecordCount("FILE_LIST") & " Files"
          Me.lstFiles = Me.lstFiles.ItemData(Me.lstFiles.ListCount - 1) 'should always be at least one
          Call lstFiles_AfterUpdate
    Next
End If
  Me.cmdParseBMPs.Enabled = True
 
ErrHandler:
  DoCmd.SetWarnings True
  AddFile = ErrorHandler(Err, "AddFile")
End Function

Open in new window

gdunn59

Author

Commented:
Rey,

The code you posted didn't work. It never opened a dialog box.

When I get to Line 13 of your code, it Exits the Function.

Also was missing the End With, so I added it after Line 36 of the code.

Thanks,
gdunn59
Top Expert 2016
Commented:
test this
Function AddFile() As LongPtr
  On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim strFileText As String
  Dim strFileName As String
  Dim j As Integer
  With Application.FileDialog(msoFileDialogOpen)
       .AllowMultiSelect = True
       .Filters.Clear
       .Filters.Add "PDFs", "*.PDF"
    
    If .Show Then
      For j = 1 To .SelectedItems.Count
      
            strFilePath = .SelectedItems(j)
            
            If GetRecordCount("SELECT * FROM FILE_LIST WHERE FILE_PATH =" & Chr(34) & strFilePath & Chr(34)) > 0 Then
              Err.Raise -666, , "This File is Already Loaded!"
            End If
          
            strFileName = Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, "\"))
            strFileText = GetFileText(strFilePath)
          
            AddFile = AddToFileList(strFilePath, strFileName, strFileText)
            If AddFile <> 0 Then Exit Function
            Me.lstFiles.Requery
            
            Me.lblFileList.Caption = GetRecordCount("FILE_LIST") & " Files"
            Me.lstFiles = Me.lstFiles.ItemData(Me.lstFiles.ListCount - 1) 'should always be at least one
            Call lstFiles_AfterUpdate
      Next
      Else
        If strFilePath = "" Then Exit Function
    End If
  End With
  Me.cmdParseBMPs.Enabled = True
 
ErrHandler:
  DoCmd.SetWarnings True
  AddFile = ErrorHandler(Err, "AddFile")
End Function

Open in new window

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Find out now!
gdunn59

Author

Commented:
Rey,

I'll have to test it tomorrow.  I'll let you know.

Thanks,
gdunn59
gdunn59

Author

Commented:
Rey,

Works like a charm!

Thanks,
gdunn59
gdunn59

Author

Commented:
Thanks!
Rey Obrero (Capricorn1)
Top Expert 2016

Commented:
you are welcome!!!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial