asked on 3/6/2017

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

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

PDF VBA Microsoft Access

Last Comment

Rey Obrero (Capricorn1)

3/7/2017

Rey Obrero (Capricorn1)

3/6/2017

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

3/7/2017

ASKER

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

ASKER CERTIFIED SOLUTION

Rey Obrero (Capricorn1)

3/7/2017