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
LVL 1
gdunn59Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rey Obrero (Capricorn1)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

0
gdunn59Author 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
0
Rey Obrero (Capricorn1)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

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Determine the Perfect Price for Your IT Services

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

gdunn59Author Commented:
Rey,

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

Thanks,
gdunn59
0
gdunn59Author Commented:
Rey,

Works like a charm!

Thanks,
gdunn59
0
gdunn59Author Commented:
Thanks!
0
Rey Obrero (Capricorn1)Commented:
you are welcome!!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
PDF

From novice to tech pro — start learning today.