How to get the file name using windows common dialog box in MS ACCESS VBA?

How to get the file name using windows common dialog box in MS ACCESS VBA?

I have an application that's working fine, just trying to add more functionality to it by giving the users an option to pick the file that they want to.
Users should click on the button, should be able to select the file from their desired location. From there, I just want to grab the file name and use it for rest another application/process.

Thanks in advance.
awarraicAsked:
Who is Participating?
 
ldunscombeCommented:
Paste the attached code into a new module and then call it as follows from your command button or wherever you like

Dim strFilePath As String
Dim strfilename As String

'Set the allowed file types, initial path and dialog title
strFilePath = fncGetFileFromAPI(".xls", "C:\", "Import File")

'Seperate the file name from the path
strfilename = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)

'If no file was selected or user cancelled then exit the sub
If Len(strfilename) < 5 Then Exit Sub

Leigh
Option Compare Database
Option Explicit

'===================================================
' Description:
' Generic Function used to call dialog box and return
' a file name and path. Allows dialog box to be called
' from any form or module with any filters
'
'===================================================
 
Public Const CONST_MDB As Byte = 1
Public Const CONST_XLS As Byte = 2
Public Const CONST_PPT As Byte = 4
Public Const CONST_DOC As Byte = 8
Public Const CONST_TXT As Byte = 16
Public Const CONST_CSV As Byte = 32
Public Const CONST_ZIP As Byte = 64
Public Const CONST_ALL As Byte = 128
 
Public strFilePath As String
 
Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Private Type OPENFILENAME
    lStructSize       As Long
    hwndOwner         As Long
    hInstance         As Long
    lpstrFilter       As String
    lpstrCustomFilter As String
    nMaxCustFilter    As Long
    nFilterIndex      As Long
    lpstrFile         As String
    nMaxFile          As Long
    lpstrFileTitle    As String
    nMaxFileTitle     As Long
    lpstrInitialDir   As String
    lpstrTitle        As String
    Flags             As Long
    nFileOffset       As Integer
    nFileExtension    As Integer
    lpstrDefExt       As String
    lCustData         As Long
    lpfnHook          As Long
    lpTemplateName    As String
End Type
 
Function fncGetFileFromAPI(strFilter As String, strInitDir As String, strCaption As String) As String
 
    Dim ret As String
    Dim n As Variant
    Dim OFN As OPENFILENAME
    Dim varItem As Variant
    
    OFN.lStructSize = Len(OFN)     ' Size of structure.
    OFN.nMaxFile = 260             ' Size of buffer.
    OFN.lpstrInitialDir = strInitDir
    OFN.lpstrTitle = strCaption
    OFN.lpstrFilter = strFilter
    OFN.lpstrFile = String(OFN.nMaxFile - 1, 0)
    ret = GetOpenFileName(OFN)  ' Call function.
    
    fncGetFileFromAPI = fncClean((OFN.lpstrFile))
        
End Function
 
Function fncGetFile(strInitDir As String, Optional intFileExt As Integer, Optional strCaption As String)
 
    Dim strFilter As String
    Dim strArgString As String
    
    If IsMissing(intFileExt) Then intFileExt = CONST_ALL
    If IsMissing(strCaption) Then strCaption = "Open"
    
    strFilter = fncBuildFilter(intFileExt)
    strFilePath = fncGetFileFromAPI(strFilter, strInitDir, strCaption)
    
    
    fncGetFile = strFilePath
    
End Function
 
Function fncBuildFilter(ByVal intFileExt As Integer) As String
 
    Dim strFilter As String
    
    If intFileExt > 128 Then intFileExt = 128
            
    If intFileExt - CONST_ALL >= 0 Then
        strFilter = "All Files" & Chr(0) & "*.*" & Chr(0)
        intFileExt = intFileExt - CONST_ALL
    End If
    
    If intFileExt - CONST_ZIP >= 0 Then
        strFilter = "Zip Files" & Chr(0) & "*.zip" & Chr(0)
        intFileExt = intFileExt - CONST_ALL
    End If
    
    If intFileExt - CONST_CSV >= 0 Then
        strFilter = strFilter & "Comma Separated Files" & Chr(0) & "*.csv" & Chr(0)
        intFileExt = intFileExt - CONST_CSV
    End If
    
    If intFileExt - CONST_TXT >= 0 Then
        strFilter = strFilter & "Text Files" & Chr(0) & "*.txt" & Chr(0)
        intFileExt = intFileExt - CONST_TXT
    End If
    
    If intFileExt - CONST_DOC >= 0 Then
        strFilter = strFilter & "Document Files" & Chr(0) & "*.doc" & Chr(0)
        intFileExt = intFileExt - CONST_DOC
    End If
    
    If intFileExt - CONST_PPT >= 0 Then
        strFilter = strFilter & "Powerpoint Files" & Chr(0) & "*.ppt" & Chr(0)
        intFileExt = intFileExt - CONST_PPT
    End If
    
    If intFileExt - CONST_XLS >= 0 Then
        strFilter = strFilter & "Excel Files" & Chr(0) & "*.xls" & Chr(0)
        intFileExt = intFileExt - CONST_XLS
    End If
    
    If intFileExt = CONST_MDB Then
        strFilter = strFilter & "Access Files" & Chr(0) & "*.mdb" & Chr(0)
    End If
        
    fncBuildFilter = strFilter
    
End Function
 
Function fncClean(strinput As String)
 
Dim X As Long
Dim strresult As String
 
For X = 1 To Len(strinput)
 
    If Asc(Mid(strinput, X, 1)) > 31 And Asc(Mid(strinput, X, 1)) < 127 Then
        strresult = strresult & Mid(strinput, X, 1)
    End If
    
Next X
 
fncClean = strresult
 
End Function

Open in new window

0
 
awarraicAuthor Commented:
I added the following code: I am getting an error, I have attached the screen shot of the error.

Option Compare Database
Option Explicit

Private Sub Command0_Click()
Dim strFilePath As String
Dim strfilename As String

'Set the allowed file types, initial path and dialog title
strFilePath = fncGetFileFromAPI(".xls", "C:\", "Import File")

'Seperate the file name from the path
strfilename = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)

'If no file was selected or user cancelled then exit the sub
If Len(strfilename) < 5 Then Exit Sub
End Sub




'===================================================
' Description:
' Generic Function used to call dialog box and return
' a file name and path. Allows dialog box to be called
' from any form or module with any filters
'
'===================================================
 
Public Const CONST_MDB As Byte = 1
Public Const CONST_XLS As Byte = 2
Public Const CONST_PPT As Byte = 4
Public Const CONST_DOC As Byte = 8
Public Const CONST_TXT As Byte = 16
Public Const CONST_CSV As Byte = 32
Public Const CONST_ZIP As Byte = 64
Public Const CONST_ALL As Byte = 128
 
Public strFilePath As String
 
Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Private Type OPENFILENAME
    lStructSize       As Long
    hwndOwner         As Long
    hInstance         As Long
    lpstrFilter       As String
    lpstrCustomFilter As String
    nMaxCustFilter    As Long
    nFilterIndex      As Long
    lpstrFile         As String
    nMaxFile          As Long
    lpstrFileTitle    As String
    nMaxFileTitle     As Long
    lpstrInitialDir   As String
    lpstrTitle        As String
    Flags             As Long
    nFileOffset       As Integer
    nFileExtension    As Integer
    lpstrDefExt       As String
    lCustData         As Long
    lpfnHook          As Long
    lpTemplateName    As String
End Type
 
Function fncGetFileFromAPI(strFilter As String, strInitDir As String, strCaption As String) As String
 
    Dim ret As String
    Dim n As Variant
    Dim OFN As OPENFILENAME
    Dim varItem As Variant
   
    OFN.lStructSize = Len(OFN)     ' Size of structure.
    OFN.nMaxFile = 260             ' Size of buffer.
    OFN.lpstrInitialDir = strInitDir
    OFN.lpstrTitle = strCaption
    OFN.lpstrFilter = strFilter
    OFN.lpstrFile = String(OFN.nMaxFile - 1, 0)
    ret = GetOpenFileName(OFN)  ' Call function.
   
    fncGetFileFromAPI = fncClean((OFN.lpstrFile))
       
End Function
 
Function fncGetFile(strInitDir As String, Optional intFileExt As Integer, Optional strCaption As String)
 
    Dim strFilter As String
    Dim strArgString As String
   
    If IsMissing(intFileExt) Then intFileExt = CONST_ALL
    If IsMissing(strCaption) Then strCaption = "Open"
   
    strFilter = fncBuildFilter(intFileExt)
    strFilePath = fncGetFileFromAPI(strFilter, strInitDir, strCaption)
   
   
    fncGetFile = strFilePath
   
End Function
 
Function fncBuildFilter(ByVal intFileExt As Integer) As String
 
    Dim strFilter As String
   
    If intFileExt > 128 Then intFileExt = 128
           
    If intFileExt - CONST_ALL >= 0 Then
        strFilter = "All Files" & Chr(0) & "*.*" & Chr(0)
        intFileExt = intFileExt - CONST_ALL
    End If
   
    If intFileExt - CONST_ZIP >= 0 Then
        strFilter = "Zip Files" & Chr(0) & "*.zip" & Chr(0)
        intFileExt = intFileExt - CONST_ALL
    End If
   
    If intFileExt - CONST_CSV >= 0 Then
        strFilter = strFilter & "Comma Separated Files" & Chr(0) & "*.csv" & Chr(0)
        intFileExt = intFileExt - CONST_CSV
    End If
   
    If intFileExt - CONST_TXT >= 0 Then
        strFilter = strFilter & "Text Files" & Chr(0) & "*.txt" & Chr(0)
        intFileExt = intFileExt - CONST_TXT
    End If
   
    If intFileExt - CONST_DOC >= 0 Then
        strFilter = strFilter & "Document Files" & Chr(0) & "*.doc" & Chr(0)
        intFileExt = intFileExt - CONST_DOC
    End If
   
    If intFileExt - CONST_PPT >= 0 Then
        strFilter = strFilter & "Powerpoint Files" & Chr(0) & "*.ppt" & Chr(0)
        intFileExt = intFileExt - CONST_PPT
    End If
   
    If intFileExt - CONST_XLS >= 0 Then
        strFilter = strFilter & "Excel Files" & Chr(0) & "*.xls" & Chr(0)
        intFileExt = intFileExt - CONST_XLS
    End If
   
    If intFileExt = CONST_MDB Then
        strFilter = strFilter & "Access Files" & Chr(0) & "*.mdb" & Chr(0)
    End If
       
    fncBuildFilter = strFilter
   
End Function
 
Function fncClean(strinput As String)
 
Dim X As Long
Dim strresult As String
 
For X = 1 To Len(strinput)
 
    If Asc(Mid(strinput, X, 1)) > 31 And Asc(Mid(strinput, X, 1)) < 127 Then
        strresult = strresult & Mid(strinput, X, 1)
    End If
   
Next X
 
fncClean = strresult
 
End Function
vba-error.bmp
0
 
ldunscombeCommented:
Is "End Sub" repeated in the OnClick Event of your command button ?

If so  remove one of them and try again or else Please supply the exact code you have in the OnClick Event of your command button.

Leigh

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.