Browse actual file vba (1 Viewer)

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Hi All

Below is the code to browse directory. Can anyone please help me with browsing the actual file instead?

Code:
Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click
    
    Dim sDirectoryName As String
    
    Me.tbHidden.SetFocus
    
    sDirectoryName = BrowseDirectory("Find and select where to export the report files.")
    
    tbDirectoryName = sDirectoryName
    
Exit_bBrowse_Click:
    Exit Sub
    
Err_bBrowse_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_bBrowse_Click
End Sub
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Code:
Public Function BrowseDirectory(szDialogTitle As String) As String
On Error GoTo Err_BrowseDirectory
    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer
    
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseDirectory = Left$(szPath, wPos - 1)
    Else
        BrowseDirectory = ""
    End If
Exit_BrowseDirectory:
    Exit Function
Err_BrowseDirectory:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_BrowseDirectory
End Function
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
any help on this guys???
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Hi CJ_London, What I am trying to do it to link the files (e.g Scanned documents,Excel,WOrd or hand written notes) to a specific record in Access database . So I want to open a file and import it . The above code I sent can select a directory and display the path of the directory in the textbox. But how can I select a particular file name ???

I got rest of the code working to import / Link it with the record.

Thanks
 

moke123

AWF VIP
Local time
Today, 13:04
Joined
Jan 11, 2013
Messages
3,852
heres a procedure i've (and many others) have used for years.

Code:
Option Compare Database
Option Explicit

'.=========================================================================
'.Browse Files Module
'.Copyright 1999 Tribble Software.  All rights reserved.
'.Phone        : (616) 455-2055
'.E-mail       : carltribble@earthlink.net
'.=========================================================================
' DO NOT DELETE THE COMMENTS ABOVE.  All other comments in this module
' may be deleted from production code, but lines above must remain.
'--------------------------------------------------------------------------
'.Description  : This module calls directly into comdlg32.dll to allow user
'.               to select a filename using the Windows Common Dialog.  The
'.               user may browse for a file, or enter a file name directly.
'.Written By   : Carl Tribble
'.Date Created : 04/05/1999 09:56:31 AM
'.Rev. History :
' Comments     : Normally, to use the Common Dialog you need to physically
'                place the ActiveX control onto a form and then use code
'                behind the form to implement its functionality.  This
'                module allows you to incorporate the functionality of the
'                File Open/Save part of the Common Dialog without the
'                ActiveX control itself. This module is completely self-
'                contained.  Simply copy it into your database to use it.
'.-------------------------------------------------------------------------
'.
' ADDITIONAL NOTES:
'
'  This module only provides the Open/Save file dialog, not the other
'  CommonDialog interfaces (ColorChooser, Help, PrintDialog, etc.)
'
'  If you want your user to browse for folder names (paths) you must use
'  the module basBrowseFolders instead.
'
'  TO STREAMLINE this module for production programs, you should remove:
'     1) Unnecessary comments
'     2) Flag Constants which you do not intend to use.
'     3) The test procedure tsGetFileFromUserTest
'
'--------------------------------------------------------------------------
'
' INSTRUCTIONS:
'
'         ( For a working example, open the Debug window  )
'         ( and enter tsGetFileFromUserTest.              )
'
'.All the arguments for the function are optional.  You may call it with no
'.arguments whatsoever and simply assign its return value to a variable of
'.the Variant type.  For example:
'.
'.   varFileName = tsGetFileFromUser()
'.
'.The function will return:
'.   the full path and filename selected or entered by the user, or
'.   Null if an error occurs or if the user presses Cancel.
'.
'.Optional arguments may include any of the following:
'. rlngFlags      : one or more of the tscFN* constants (declared below)
'.                  Combine multiple constants like this:
'.                   tscFNHideReadOnly Or tscFNFileMustExist
'. strInitialDir : the directory to display when dialog opens
'. strFilter     : a string containing any filters you want to use. Each
'.                 part must be separated by the vbNullChar. -example below
'. lngFilterIndex: a 1-based index indicating which filter to start with.
'. strDefaultExt : Extension to use if user does not enter one.
'. strFileName   : Default File to display in the File Name text box.
'. strDialogTitle: Caption to display in the dialog's title bar.
'. fOpenFile     : Boolean-True for the Open dialog, False for Save dialog.
'
' FILTER EXAMPLE: The filter must be a string containing two parts for each
'  filter.  The first part is the Description, it is what the user will see
'  in the Files of Type box, e.g. "Text Files (*.txt)".  The second part is
'  the actual filter, e.g. "*.txt".  Each part and each filter must be
'  separated by the vbNullChar.  For example, to provide two filters, one for
'  *.mdb files, and one for all files, use a statement like this:
'
'  strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
   '   & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
'
'  Then pass your strFilter variable as the strFilter argument for the call
'  to tsGetFileFromUser()
'
'.--------------------------------------------------------------------------
'.

Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
                                               Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
                                               Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Type tsFileName
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
       Optional ByRef rlngflags As Long = 0&, _
       Optional ByVal strInitialDir As String = "", _
       Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
       Optional ByVal lngFilterIndex As Long = 1, _
       Optional ByVal strDefaultExt As String = "", _
       Optional ByVal strFileName As String = "", _
       Optional ByVal strDialogTitle As String = "Link File", _
       Optional ByVal fOpenFile As Boolean = True) As Variant
    On Error GoTo tsGetFileFromUser_Err

    Dim tsFN As tsFileName
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Allocate string space for the returned strings.
    strFileName = Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)

    ' Set up the data structure before you call the function
    With tsFN
        .lStructSize = Len(tsFN)
        .hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = lngFilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .flags = rlngflags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitialDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With

    ' Call the function in the windows API
    If fOpenFile Then
        fResult = ts_apiGetOpenFileName(tsFN)
    Else
        fResult = ts_apiGetSaveFileName(tsFN)
    End If

    ' If the function call was successful, return the FileName chosen
    ' by the user.  Otherwise return null.  Note, the CancelError property
    ' used by the ActiveX Common Dialog control is not needed.  If the
    ' user presses Cancel, this function will return Null.
    If fResult Then
        rlngflags = tsFN.flags
        tsGetFileFromUser = tsTrimNull(tsFN.strFile)
    Else
        tsGetFileFromUser = Null
    End If

    ''''''''''''''''''''''''''''''
    ' If tsGetFileFromUser <> "" Then

    'Dim fname As String
    'fname = mid(tsGetFileFromUser, InStrRev(tsGetFileFromUser, "\", -1) + 1)


    'End If

    'MsgBox DCount("fpath", "tblfiles", "CaseID = " & vCaseID & " and fpath = " & Chr(34) & tsGetFileFromUser & Chr(34))

    ''''''''''''''''''''''''''''''''''''''''''''''


tsGetFileFromUser_End:
    On Error GoTo 0
    Exit Function

tsGetFileFromUser_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
                            & " in function basBrowseFiles.tsGetFileFromUser"
    Resume tsGetFileFromUser_End

End Function

' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
    On Error GoTo tsTrimNull_Err
    Dim I As Integer

    I = InStr(strItem, vbNullChar)
    If I > 0 Then
        tsTrimNull = Left(strItem, I - 1)
    Else
        tsTrimNull = strItem
    End If

tsTrimNull_End:
    On Error GoTo 0
    Exit Function

tsTrimNull_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
                            & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End

End Function

note: there used to be an additional procedure - tsGetFileFromUserTest- included with this procedure but it appears that i deleted it at some point, so its not included. that procedure was just a test of how the procedure worked as noted in the instructions above.
 
Last edited:

isladogs

MVP / VIP
Local time
Today, 17:04
Joined
Jan 14, 2017
Messages
18,186
Moke beat me to it ...

Here's a different version of the same idea which I use to select a file & attach it to a record.

This code is for a form with a frame fraLinkFile & 3 checkboxes: Attach File / View File / Remove File.
The attached file is displayed in a textbox 'LinkedFile'

NOTE: If you try this you will need to define some additional variables at the start of the code module for this form i.e. after Option Explicit

Code:
Dim F As FileDialog
Dim strMsgReturn As String, strFilePath As String, strFileName As String, strFolderPath As String 
Dim strNewFilePath As String, strFileType As String

'Define where linked files will be stored on the network
'####MODIFY THE NEXT LINE for your database & network####
'you can use a fixed file path or a lookup function here e.g.
Const GetLinkedFilesPath = "G:\Programs\MendipDataSystems\CommonFiles\SDA\LinkedFiles\"
'Const  GetLinkedFilesPath = Nz(DLookup("Value", "SchConstants", "Alias = 'strLinkedFilesPath'"), "")

Here is the code for the frame & checkboxes:

Code:
Private Sub fraLinkFile_AfterUpdate()
'Added to handle linked files
'CR 29/08/2015 - Code rewritten to ensure compatibility with 64-bit Office

On Error GoTo Err_Handler
    
Select Case Me.fraLinkFile

Case 1 'Link a selected file . . .

    'Check for existing linked file
    If Nz(Me.LinkedFile, "") <> "" Then
    strMsgReturn = MsgBox("Only ONE file can be linked to a pastoral record.        " & vbNewLine & vbNewLine & _
        "A file is already attached to this pastoral record.    " & vbNewLine & _
        "Linking another file will remove the existing link." & vbNewLine & vbNewLine & _
     "Do you want to continue?", vbCritical + vbYesNo + vbDefaultButton2, "Link another file?")
        If strMsgReturn = vbNo Then
            Me.fraLinkFile = 0
            Exit Sub
        End If
    End If
    
    'Run File . . .Open dialog
    ' Set options for the dialog box.
    Set F = Application.FileDialog(msoFileDialogFilePicker)
    F.Title = "Locate the file to be linked and click on 'Open'"
    F.AllowMultiSelect = False
    
    ' Clear out the current filters
        F.Filters.Clear
        
    ' Set the start folder
        F.InitialFileName = "c:\"
        
    ' Call the Open dialog routine.
        F.Show

' Return the path and file name.
    'strFilePath = FindFilePath("explorer.exe /e,::{208D2C60-3AEA-1069-A2D7-08002B30309D}") 'My Computer
    strFilePath = F.SelectedItems(1)
    
    'Determine folder path
    strFolderPath = Trim(strFilePath)
    Do Until Right((strFolderPath), 1) = "\"
        strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
    Loop
        
    'Determine file name
    strFileName = Mid(strFilePath, Len(strFolderPath) + 1)
    
    'Determine file type e.g. ".doc" so it can be added to new filename if needed
    strFileType = Trim(strFileName)
    If InStr(strFileType, ".") = 0 Then 'file has no file type suffix . . .reject it!
        MsgBox "This file cannot be used as the file type is unknown    ", vbCritical, "Unknown file type"
        GoTo Clear
    Else 'file type suffix OK. . . .
        Do Until Left((strFileType), 1) = "."
        strFileType = Mid(strFileType, 2)
        Loop
    End If
       
    'Inform user that the file will be copied to the network
     strMsgReturn = MsgBox("The selected file needs to be copied to the network.     " & vbNewLine & _
     "so it can be viewed by other users" & vbNewLine & vbNewLine & _
     "Do you want to continue?", vbExclamation + vbYesNo, "Copy selected file?")
    If strMsgReturn = vbNo Then GoTo Clear
        
    'Copy to LinkedFiles folder on network
    strNewFilePath = GetLinkedFilesPath & strFileName
    
    If Len(strNewFilePath) > 255 Then
        strMsgReturn = MsgBox("The file name is too long (>255 characters)     " & vbNewLine & _
          "Do you want to save it with a new name?", vbCritical + vbYesNo, "Copy selected file?")
        If strMsgReturn = vbYes Then
            strFileName = InputBox("Enter a new name for this file", "New file name")
            strNewFilePath = GetLinkedFilesPath & strFileName & strFileType
            FileCopy strFilePath, strNewFilePath
        Else
            MsgBox "The file was not linked as its file name was too long (>255 characters)     "
        End If
    End If
    
    'Check whether file already exists
    If (Dir(strNewFilePath) = "") Then 'file missing  . . . so copy it
        FileCopy strFilePath, strNewFilePath
    Else
Rename:
        strMsgReturn = MsgBox("Another file with this name already exists on the network.     " & vbNewLine & _
          "Do you want to save it with a new name?", vbCritical + vbYesNo, "Copy selected file?")
        If strMsgReturn = vbYes Then
            strFileName = InputBox("Enter a new name for this file", "New file name")
            strNewFilePath = GetLinkedFilesPath & strFileName & strFileType
            If (Dir(strNewFilePath) <> "") Then GoTo Rename 'this file also exists, so try again
            FileCopy strFilePath, strNewFilePath 'copy the file
        Else ' Use existing linked file - CR v4683
            'GoTo Clear 'cancel the file copy
        End If
    End If
       
    'Update record
    Me.LinkedFile = strNewFilePath
    
    'Show attached file details
    Me.LinkedFile.visible = True
    Me.LblLinkedFile.visible = True
    Me.BoxLinkedFile.visible = True
       
    'View attached file
    strMsgReturn = MsgBox("Do you want to view the linked file now?   ", vbExclamation + vbYesNo + vbDefaultButton2, "View file?")
        If strMsgReturn = vbNo Then GoTo Clear
    ViewFile
    
Clear:
    Me.fraLinkFile = 0
        
Case 2 'View selected file
    ViewFile

Case 3 'Remove & delete the attached file
    RemoveFile
       
End Select

Me.fraLinkFile = 0

Exit_Handler:
    Exit Sub

Err_Handler:
    If Err.Number = 5 Then
        Me.fraLinkFile = 0
        Exit Sub
    
    ElseIf Err.Number = 53 Then
        Resume Exit_Handler
    Else
        MsgBox "Error " & err.Number & " in fraLinkFile_AfterUpdate procedure : " & err.Description
        Resume Exit_Handler
    End If
    
End Sub

Also add these two procedures to the same form:

Code:
Private Sub RemoveFile()

On Error GoTo Err_Handler

'Removes link to selected file and deletes copy in LinkedFiles folder on network

    strFileName = Nz(Me.LinkedFile, "")
    Debug.Print strFileName

    If strFileName = "" Then
        MsgBox "There is no file attached    ", vbInformation, "No attachment"
        Exit Sub
    End If
    
    strMsgReturn = MsgBox("Are you sure you want to remove the linked file?    ", vbExclamation + vbYesNo + vbDefaultButton2, _
        "Remove attachment?")
    If strMsgReturn = vbNo Then Exit Sub
                    
    'Hide attached file details
    Me.LinkedFile.visible = False
    Me.LblLinkedFile.visible = False
    Me.BoxLinkedFile.visible = False
    Me.LinkedFile = ""
    
'######################################
'MODIFY the DCount lines below for your database
    'Check if linked file is attached to any other records before deleting file
    icount = Nz(DCount("PastoralRecordID", "PRecords", "LinkedFile= '" & strFileName & "'"), 0)
    jCount = Nz(DCount("PupilID", "SENPupilConcerns", "LinkedFile= '" & strFileName & "'"), 0) 'added v4611W
       
    If icount + jCount > 0 Then
        Exit Sub 'other records are linked to file . . .do not delete from network
    Else
        Kill strFileName 'delete the file
        MsgBox "The linked file has also been deleted from the network   ", vbInformation, "File Deleted"
    End If

Exit_Handler:
    Exit Sub

Err_Handler:
  '  If err.Number = 5 Then Exit Sub
  '  If err.Number = 53 Then Resume Exit_fraLinkFile_AfterUpdate
    If Err.Number = 94 Then Exit Sub 'no linked file
    If Err.Number = 3146 Then Exit Sub
    
    MsgBox "Error " & err.Number & " in RemoveFile procedure : " & err.Description
    Resume Exit_Handler

End Sub

'===============================

Private Sub ViewFile() 

On Error GoTo Err_Handler

    strFileName = Nz(Me.LinkedFile, "")

    If strFileName = "" Then
        MsgBox "There is no linked file     ", vbInformation, "No linked file"
        Exit Sub
    End If

    'Check document exists
    If (Dir(strFileName) = "") Then 'file missing  . . . show error message
        MsgBox "The file cannot be found.  ", vbExclamation, "Action Cancelled"
        Exit Sub
    End If

    StatusBar ("Opening the file, please wait . . .") 'show message while file opens
    Call fHandleFile(strFileName, WIN_NORMAL)
    StatusBar 'clear message

Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & err.Number & " in ViewFile procedure : " & err.Description
    Resume Exit_Handler
    
End Sub

You will also need to copy the following code into a new module:

Code:
Option Compare Database
Option Explicit

'Following code is by Dev Ashish

'###############################################
'Add PtrSafe - required for 64-bit Office (VBA7)
#If VBA7 Then
        Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
        (ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) _
        As Long
#ElseIf Win64 Then 'need datatype LongPtr
    Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
        (ByVal hwnd As LongPtr, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As LongPtr) _
        As LongPtr
#Else '32-bit Office
    Private Declare Function apiShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
        (ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) _
        As Long
#End If
'###############################################

Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

==================================
Public Sub StatusBar(Optional msg As Variant)

On Error GoTo ErrHandler
Dim temp As Variant

' if the Msg variable is omitted or is empty, return the control of the status bar to Access

    If Not IsMissing(msg) Then
        If msg <> "" Then
            temp = SysCmd(acSysCmdSetStatus, msg)
        Else
            temp = SysCmd(acSysCmdClearStatus)
        End If
    Else
        temp = SysCmd(acSysCmdClearStatus)
    End If
    
ExitHandler:
    Exit Sub
    
ErrHandler:
    MsgBox "Error " & Err.Number & " in StatusBar procedure : " & Err.Description
    Resume ExitHandler
End Sub


Function fHandleFile(stFile As String, lShowHow As Long)

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function

'===============================================
'Now all you need to do is call the application with the path of the file and let Windows do the rest.
'This code can be used to start any registered applications, including another instance of Access.
'If it doesn't know what application to open the file with, it just pops up the standard "Open With.." dialog.
'It can even handle URL's and mailto:

'Open a folder:
'  fHandleFile("C:\TEMP\",WIN_NORMAL)

'Call Email app:
'  fHandleFile("mailto:bpo@yahoo.com",WIN_NORMAL)

'Open URL:
' fHandleFile("http://uk.yahoo.com";, WIN_NORMAL)

'Handle Unknown extensions:
' fHandleFile("C:\TEMP\TestThis",Win_Normal)
'===============================================

Alternatively the attached db has 1 form frmAttachFile which is used when you want to attach one or more files to an email
 

Attachments

  • Browse&AttachFile.accdb
    428 KB · Views: 97
Last edited:

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Ridders, I coipied the code for cmdBrowse button in my database but its giving me complie error "user-defined type not defined" at the following line

Code:
 Dim F As FileDialog

Any ideas why?
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Hi Moke

Why it only shows Microsoft word ? The file could be be anything .

And also im getting error message at the following line. It says lastinstr not found.
Code:
If str <> "" Then
        
        str = Right(str, Len(str) - LastInStr(str, "\"))
        Me.txtFile.Value = str
    End If

heres a procedure i've (and many others) have used for years.

Code:
Option Compare Database
Option Explicit

'.=========================================================================
'.Browse Files Module
'.Copyright 1999 Tribble Software.  All rights reserved.
'.Phone        : (616) 455-2055
'.E-mail       : carltribble@earthlink.net
'.=========================================================================
' DO NOT DELETE THE COMMENTS ABOVE.  All other comments in this module
' may be deleted from production code, but lines above must remain.
'--------------------------------------------------------------------------
'.Description  : This module calls directly into comdlg32.dll to allow user
'.               to select a filename using the Windows Common Dialog.  The
'.               user may browse for a file, or enter a file name directly.
'.Written By   : Carl Tribble
'.Date Created : 04/05/1999 09:56:31 AM
'.Rev. History :
' Comments     : Normally, to use the Common Dialog you need to physically
'                place the ActiveX control onto a form and then use code
'                behind the form to implement its functionality.  This
'                module allows you to incorporate the functionality of the
'                File Open/Save part of the Common Dialog without the
'                ActiveX control itself. This module is completely self-
'                contained.  Simply copy it into your database to use it.
'.-------------------------------------------------------------------------
'.
' ADDITIONAL NOTES:
'
'  This module only provides the Open/Save file dialog, not the other
'  CommonDialog interfaces (ColorChooser, Help, PrintDialog, etc.)
'
'  If you want your user to browse for folder names (paths) you must use
'  the module basBrowseFolders instead.
'
'  TO STREAMLINE this module for production programs, you should remove:
'     1) Unnecessary comments
'     2) Flag Constants which you do not intend to use.
'     3) The test procedure tsGetFileFromUserTest
'
'--------------------------------------------------------------------------
'
' INSTRUCTIONS:
'
'         ( For a working example, open the Debug window  )
'         ( and enter tsGetFileFromUserTest.              )
'
'.All the arguments for the function are optional.  You may call it with no
'.arguments whatsoever and simply assign its return value to a variable of
'.the Variant type.  For example:
'.
'.   varFileName = tsGetFileFromUser()
'.
'.The function will return:
'.   the full path and filename selected or entered by the user, or
'.   Null if an error occurs or if the user presses Cancel.
'.
'.Optional arguments may include any of the following:
'. rlngFlags      : one or more of the tscFN* constants (declared below)
'.                  Combine multiple constants like this:
'.                   tscFNHideReadOnly Or tscFNFileMustExist
'. strInitialDir : the directory to display when dialog opens
'. strFilter     : a string containing any filters you want to use. Each
'.                 part must be separated by the vbNullChar. -example below
'. lngFilterIndex: a 1-based index indicating which filter to start with.
'. strDefaultExt : Extension to use if user does not enter one.
'. strFileName   : Default File to display in the File Name text box.
'. strDialogTitle: Caption to display in the dialog's title bar.
'. fOpenFile     : Boolean-True for the Open dialog, False for Save dialog.
'
' FILTER EXAMPLE: The filter must be a string containing two parts for each
'  filter.  The first part is the Description, it is what the user will see
'  in the Files of Type box, e.g. "Text Files (*.txt)".  The second part is
'  the actual filter, e.g. "*.txt".  Each part and each filter must be
'  separated by the vbNullChar.  For example, to provide two filters, one for
'  *.mdb files, and one for all files, use a statement like this:
'
'  strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
   '   & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
'
'  Then pass your strFilter variable as the strFilter argument for the call
'  to tsGetFileFromUser()
'
'.--------------------------------------------------------------------------
'.

Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
                                               Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
                                               Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Type tsFileName
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
       Optional ByRef rlngflags As Long = 0&, _
       Optional ByVal strInitialDir As String = "", _
       Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
       Optional ByVal lngFilterIndex As Long = 1, _
       Optional ByVal strDefaultExt As String = "", _
       Optional ByVal strFileName As String = "", _
       Optional ByVal strDialogTitle As String = "Link File", _
       Optional ByVal fOpenFile As Boolean = True) As Variant
    On Error GoTo tsGetFileFromUser_Err

    Dim tsFN As tsFileName
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Allocate string space for the returned strings.
    strFileName = Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)

    ' Set up the data structure before you call the function
    With tsFN
        .lStructSize = Len(tsFN)
        .hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = lngFilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .flags = rlngflags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitialDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With

    ' Call the function in the windows API
    If fOpenFile Then
        fResult = ts_apiGetOpenFileName(tsFN)
    Else
        fResult = ts_apiGetSaveFileName(tsFN)
    End If

    ' If the function call was successful, return the FileName chosen
    ' by the user.  Otherwise return null.  Note, the CancelError property
    ' used by the ActiveX Common Dialog control is not needed.  If the
    ' user presses Cancel, this function will return Null.
    If fResult Then
        rlngflags = tsFN.flags
        tsGetFileFromUser = tsTrimNull(tsFN.strFile)
    Else
        tsGetFileFromUser = Null
    End If

    ''''''''''''''''''''''''''''''
    ' If tsGetFileFromUser <> "" Then

    'Dim fname As String
    'fname = mid(tsGetFileFromUser, InStrRev(tsGetFileFromUser, "\", -1) + 1)


    'End If

    'MsgBox DCount("fpath", "tblfiles", "CaseID = " & vCaseID & " and fpath = " & Chr(34) & tsGetFileFromUser & Chr(34))

    ''''''''''''''''''''''''''''''''''''''''''''''


tsGetFileFromUser_End:
    On Error GoTo 0
    Exit Function

tsGetFileFromUser_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
                            & " in function basBrowseFiles.tsGetFileFromUser"
    Resume tsGetFileFromUser_End

End Function

' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
    On Error GoTo tsTrimNull_Err
    Dim I As Integer

    I = InStr(strItem, vbNullChar)
    If I > 0 Then
        tsTrimNull = Left(strItem, I - 1)
    Else
        tsTrimNull = strItem
    End If

tsTrimNull_End:
    On Error GoTo 0
    Exit Function

tsTrimNull_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
                            & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End

End Function
note: there used to be an additional procedure - tsGetFileFromUserTest- included with this procedure but it appears that i deleted it at some point, so its not included. that procedure was just a test of how the procedure worked as noted in the instructions above.
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Ridders, I'm getting the following error message

'FileDialog' of Object '_Application' failed
 

isladogs

MVP / VIP
Local time
Today, 17:04
Joined
Jan 14, 2017
Messages
18,186
Ridders, I coipied the code for cmdBrowse button in my database but its giving me complie error "user-defined type not defined" at the following line

Code:
 Dim F As FileDialog

Any ideas why?

Hi
Sorry you need to add the reference 'Microsoft Office 14.0 Object Library' if you are using Access 2010 (or 15.0 for 2013 etc)
If it still doesn't compile also add Microsoft Forms 2.0 Object Library'

Hopefully that will also solve

the following error message
'FileDialog' of Object '_Application' failed

I also use the same code in the Browse&AttachFile.accdb so you can test it there.
I added those 2 references to make it work as a standalone file/form.
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Ridders, You're a star..Thanks so much for all your help. :)
 

moke123

AWF VIP
Local time
Today, 13:04
Joined
Jan 11, 2013
Messages
3,852
And also im getting error message at the following line. It says lastinstr not found.

I have no clue. Its not in the procedure i posted.
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
That's a different procedure. thanks for your help. :)
 

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Just wondering is it possible to import the file in access rather than just linking to the database. There might be a situation if the path of the file is changed then linking will cause the problem .

Any suggestions on this guys?
 
Last edited:

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
The following code I'm using to link file to a specifc record:
Code:
Private Sub bImport1_Click()
 Dim strSql                  As String
  Dim db                      As DAO.Database
  Dim rs                      As DAO.Recordset
  On Error GoTo ErrorHandler
  Set db = CurrentDb()
  strSql = "SELECT * FROM tImport WHERE 1=0"
  Set rs = db.OpenRecordset(strSql, dbOpenDynaset, dbSeeChanges)
  rs.AddNew
  rs!filename = Me.txtFile
  rs!ActivityRef = Me.txtRefNo
  rs!FormRef = 24
  rs.Update
  
  MsgBox "The new document has been attached", vbInformation + vbOKOnly, "Added"
  
 
  Forms!frmCall!lstDocs.Requery
  
  DoCmd.Close acForm, Me.Name
ExitHandler:
  Set rs = Nothing
  Set db = Nothing
  Exit Sub
ErrorHandler:
  Select Case Err
    Case Else
      MsgBox Err.Description & " in bImport1_Click "
      DoCmd.Hourglass False
      Resume ExitHandler
  End Select
End Sub
 

isladogs

MVP / VIP
Local time
Today, 17:04
Joined
Jan 14, 2017
Messages
18,186
Just wondering is it possible to import the file in access rather than just linking to the database. There might be a situation if the path of the file is changed then linking will cause the problem .

Go to External Data and look at the file types that can be imported.
e.g. xls(x); csv; txt ; xml ; html

However even if the file type is listed, it doesn't mean the data it contains is laid out in a way that can be imported easily

If its not listed, you can't import the data - FULL STOP e.g. doc(x)

It is possible to ATTACH files using the Attachment field type.
However I never do that and I strongly recommend you DON'T either
One reason is that it will cause your db to BLOAT significantly.
Before long you'll hit the 2GB limit & have a db you can't even open

One further way around that is to make a copy of the file you want to link & save that to a specified location on the newtork.
You then link to the network copy.
Then the original file isn't used & it doesn't matter if its deleted
However if the original is edited, that won't show up in the network copy unless you repeat the process

Each method has its +/- points. You choose...
 
Last edited:

aman

Registered User.
Local time
Today, 10:04
Joined
Oct 16, 2008
Messages
1,250
Ok. But if I'm using the existing file type e.g PDF then can this be imported in access using vba . SO basically instead of linking to the file , just import it in access??
 

isladogs

MVP / VIP
Local time
Today, 17:04
Joined
Jan 14, 2017
Messages
18,186
Ok. But if I'm using the existing file type e.g PDF then can this be imported in access using vba . SO basically instead of linking to the file , just import it in access??

Saw this just after my last post.
I'm 99.9% certain you can't import a PDF file
 

Users who are viewing this thread

Top Bottom