Button in subform with two routine (1 Viewer)

E

ebbsamsung

Registered User.
Local time
Today, 13:22
Joined
May 22, 2014
Messages
19
Dear Experts,

Good day!

I actually had a problem in my db. My boss want me to make a button in a subform detail to open specific pdf file based on path listed in table named "tblPDF" and concatenate a field DocumentNo in subform. I've done this part using the code i found in a forum. But now, my boss want as well if the pdf file not there, it will open the window explorer setfocus to the folder name identical to the DocumentNo.

Is is possible to please modify the code i found to fit the need of my boss?
I am very sorry, as a novice like i need your help for this matter.

I attached herein the screenshots of the table, form with subform and a directory folder.

Here is the code i used so far to open pdf file

Thank you in advance experts!



Code: 
Private Sub cmdOpenPDF_Click()

Dim colFiles As New Collection
Dim direc As String
Dim filetosearch As String
filetosearch = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo & ".pdf"


direc = Nz(DLookup("PDFsFolder", "tblPDF", "PdfId = 14"), "")
RecursiveDir colFiles, direc, filetosearch, True
Dim vFile As Variant
For Each vFile In colFiles
OpenAnyFile (vFile)
Next vFile

End Sub


Function OpenAnyFile(strPath As String)
If FileThere(strPath) Then
MsgBox ("Open PDF file for " & No & "_" & DocumentNo & "_" & RevisionNo & "?")
FollowHyperlink strPath
Else
MsgBox ("File not found")
End If
End Function
Function FileThere(fileName As String) As Boolean
If (Dir(fileName) = "") Then
FileThere = False
Else
FileThere = True
End If
End Function
 
Last edited:
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 04:22
Joined
May 7, 2009
Messages
19,230
modify this part to:

For Each vFile In colFiles
OpenAnyFile (vFile, direc)
Next vFile
...
...
...



Function OpenAnyFile(strPath As String , direc as string)
If FileThere(strPath) Then
MsgBox ("Open PDF file for " & No & "_" & DocumentNo & "_" & RevisionNo & "?")
FollowHyperlink strPath
Else
MsgBox ("File not found")
FollowHyperlink direc
End If
End Function
 
isladogs

isladogs

MVP / VIP
Local time
Today, 21:22
Joined
Jan 14, 2017
Messages
18,215
Cross posted with answers at http://www.accessforums.net/showthread.php?t=71629

If you do cross post, please state you have done so & provide a link at each forum

I expect arnel's solution will work, but if not, here's an alternative for you to adapt:

Button code for your form:
Code: 
Private Sub cmdOpenFileOrFolder_Click()

On Error GoTo Err_Handler

    Dim strFileName As String, strFolderName As String, strFilePath As String

   [COLOR="seagreen"]
    'enter details of your file name & folder name e.g. using DLookup
    'concatenate to get the full older path [/COLOR]
    strFilepath = strFolderName & "\" & strFileName
    
  [COLOR="seagreen"]  'Check file exists[/COLOR]
    If Dir(strFilename) <> "" Then 
	Statusbar ("Opening the file, please wait. . .")[COLOR="seagreen"] 'show message while file opens[/COLOR]
    	Call fHandleFile(strFilePath, WIN_NORMAL)
    	Statusbar 'clear message
    Else [COLOR="seagreen"]'file missing . . . show error message[/COLOR]
       Shell "C:\WINDOWS\explorer.exe """ & strFolderName & "", vbNormalFocus 
    End If
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.number & " in cmdOpenFileOrFolder_Click procedure :             " & _
        Err.description, vbCritical, "Program error"
    Resume Exit_Handler
End Sub

NOTE: fHandleFile is another generic function to open any file using the default file handler.
Place this code in a module:

Code: 
Option Compare Database
Option Explicit

Dim fso As Object

 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&

[COLOR="SeaGreen"]'---------------------------------------------------[/COLOR]

Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
   [COLOR="seagreen"] 'First try ShellExecute[/COLOR]
    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:
               [COLOR="seagreen"] 'Try the OpenWith dialog[/COLOR]
                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)
                
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.number & " in fHandleFile procedure : " & Err.description, vbOKOnly + vbCritical
    Resume Exit_Handler

End Function

[COLOR="SeaGreen"]'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)
[/COLOR]
 
E

ebbsamsung

Registered User.
Local time
Today, 13:22
Joined
May 22, 2014
Messages
19
Sir Ridders,

I adapted the code you've posted and this is what ive got so far.
I was able to open the window explorer directing to the path mentioned in tblFolder.
The original path or location of the folder is like this:

S:\Final Document for Project\Part 2. Procurement Manual\Section 1_Mechanical\Subsection 1-1_GT, GTG & ST, STG_Siemens AG\

But what i did in the tblFolder was, I shorten the path like this:
S:\Final Document for Project\Part 2. Procurement Manual\Section 1_Mechanical\

The purpose of this is when the user click the button, the code runs same as recursive maybe, I dont know whats the exact word to say but something like that looking the exact folder in subfolder and open in window explorer

This is the code you've given and i tried but the window explorer is opening the My Documents

Sorry I am a novice of this Access and VBA, :banghead:

Code: 
Private Sub cmdOpenFolder_Click()
On Error GoTo Err_Handler

    Dim strFileName As String, strFolderName As String, strFilePath As String
    strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo
    strFolderName = Nz(DLookup("PDFsFolder", "tblFolder", "PdfId = 1"), "")
   
    'enter details of your file name & folder name e.g. using DLookup
    'concatenate to get the full older path
    strFilePath = strFolderName & "\" & strFileName
    
    'Check file exists
    If Dir(strFileName) <> "" Then
        'StatusBar ("Opening the file, please wait. . .") 'show message while file opens
        Call fHandleFile(strFilePath, WIN_NORMAL)
        'StatusBar 'clear message
    Else 'file missing . . . show error message
       Shell "C:\WINDOWS\explorer.exe """ & strFolderName & strFileName & "", vbNormalFocus
    End If
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " in cmdOpenFolder_Click procedure :             " & _
        Err.Description, vbCritical, "Program error"
    Resume Exit_Handler
End Sub
 
isladogs

isladogs

MVP / VIP
Local time
Today, 21:22
Joined
Jan 14, 2017
Messages
18,215
the code runs same as recursive maybe
Click to expand...
Sorry - no idea what that means

You've altered my code but not done so correctly:
Part of the problem is that you may have 2 backslashes

Add the 3 debug lines shown in BLUE so you can see what you are using
1. Do you have .pdf at the end of strFileName? If not add it as shown in RED
2. If you have a backslash at the end of strFolderName then either remove it there or remove it in the strFilePath concatenation code (the part in RED)
3. The Shell line should not include the strfilename part (again in RED). Remove that - what I wrote before was correct

Code: 
Private Sub cmdOpenFolder_Click()
On Error GoTo Err_Handler

    Dim strFileName As String, strFolderName As String, strFilePath As String
    strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo [COLOR="red"]& ".pdf"[/COLOR]
    strFolderName = Nz(DLookup("PDFsFolder", "tblFolder", "PdfId = 1"), "")

   [COLOR="Blue"] Debug.Print strFolderName
    Debug.Print strFileName[/COLOR]
   
    'enter details of your file name & folder name e.g. using DLookup
    'concatenate to get the full older path
    strFilePath = strFolderName & [COLOR="Red"]"\" & [/COLOR] strFileName

    [COLOR="blue"]Debug.Print strFilePath[/COLOR]
    
    [COLOR="seagreen"]'Check file exists[/COLOR]
    If Dir(strFileName) <> "" Then
       Call fHandleFile(strFilePath, WIN_NORMAL)
    Else[COLOR="SeaGreen"] 'file missing . . . show folder[/COLOR]
       Shell "C:\WINDOWS\explorer.exe """ & strFolderName  [COLOR="red"]& strFileName[/COLOR] & "", vbNormalFocus
    End If
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " in cmdOpenFolder_Click procedure :             " & _
        Err.Description, vbCritical, "Program error"
    Resume Exit_Handler
End Sub
 
E

ebbsamsung

Registered User.
Local time
Today, 13:22
Joined
May 22, 2014
Messages
19
Sir Ridders,

Sorry for the late reply, I actually follow what you've said and the code working fine to pop the window explorer but the pdf file not. Maybe I miss something or what, could you please check sir.

' This is a concatenation of fields in a subform with an addition of particular file extension to find

strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo & ".pdf"

'In this part the path is not fully listed in the table and it goes like this only:
(S:\Final Document for Project\Part 2. Procurement Manual\Section 1_Mechanical)
The full path is:
(S:\Final Document for Project\Part 2. Procurement Manual\Section 1_Mechanical\Subsection 1-1_GT, GTG & ST, STG_Siemens AG)
for one file in the subform list only. This is the reason why I purposely listed the path in a table not in full because not all file pointed to one directory or folder.

strFolderName = Nz(DLookup("PDFsFolder", "tblFolder", "PdfId = 1"), "")

Is it possible the code routine runs like this:

Find first using the strFoldername & strFileName and pop up if there is a pdf file and if not open the subfolder named the same as strFileName without the addition of ".pdf" extention


Thank you in advance

Code: 
Private Sub cmdOpenFolder_Click()
On Error GoTo Err_Handler

    Dim strFileName As String, strFolderName As String, strFilePath As String
    strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo & ".pdf"
    strFolderName = Nz(DLookup("PDFsFolder", "tblFolder", "PdfId = 1"), "")

    Debug.Print strFolderName
    Debug.Print strFileName
   
    'enter details of your file name & folder name e.g. using DLookup
    'concatenate to get the full older path
    strFilePath = strFolderName & "\" &  strFileName

    Debug.Print strFilePath
    
    'Check file exists
    If Dir(strFileName) <> "" Then
     ' This part I want to open the pdf file if available
       Call fHandleFile(strFilePath, WIN_NORMAL)
    Else 'file missing . . . show folder
      'This part if no pdf  file then pop up the window explorer pointing to the foldername the same  as pdf file. This is because the file name of the pdf file is same also  with the foldername
       Shell "C:\WINDOWS\explorer.exe """ & strFolderName  & "", vbNormalFocus
    End If
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " in cmdOpenFolder_Click procedure :             " & _
        Err.Description, vbCritical, "Program error"
    Resume Exit_Handler
End Sub
 
E

ebbsamsung

Registered User.
Local time
Today, 13:22
Joined
May 22, 2014
Messages
19
Sir Ridders,

First, I modified the path and the If statement by adding "*" in it and its working fine to pop up the pdf file and if nothing there, the last part of the code wont pop up the window explorer pointing to the folder.

Second, if i retain as is your code, it will not pop up the pdf file even if its there instead it pop up the window explorer pointing to the folder.


Dim strFileName As String, strFolderName As String, strFilePath As String
strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo & ".pdf"
strFolderName = Application.HyperlinkPart(FileLocation)
'enter details of your file name & folder name e.g. using DLookup
'concatenate to get the full older path
strFilePath = strFolderName & "" & strFileName



'Check file exists
If Dir(strFileName) <> "*" Then
Call fHandleFile(strFilePath, WIN_NORMAL)
'StatusBar 'clear message
Else 'file missing . . . show error message
Shell "C:\WINDOWS\explorer.exe """ & strFolderName & "", vbNormalFocus
End If


Exit_Handler:
Exit Sub

Err_Handler:
MsgBox "Error " & Err.Number & " in cmdOpenFolder_Click procedure : " & _
Err.Description, vbCritical, "Program error"
Resume Exit_Handler
End Sub
 
isladogs

isladogs

MVP / VIP
Local time
Today, 21:22
Joined
Jan 14, 2017
Messages
18,215
OK - you've still made mistakes in adapting my code
However I also made a mistake - apologies which is why you used the "*"
The Dir line should read Dir(strFilePath) <> "" - please amend

Corrected version below (changes in RED)
I've fixed the Dir line & also added code to handle path depending on whether folder name has a trailing "" or not
If you use this in its entirety it should work

Having said that I've never used HyperlinkPart myself....

Code: 
Private Sub cmdOpenFolder_Click()

On Error GoTo Err_Handler

    Dim strFileName As String, strFolderName As String, strFilePath As String
         
   strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo & ".pdf"
   strFolderName = Application.HyperlinkPart(FileLocation)

    'concatenate to get the full folder path 
    'check for trailing backslash

 [COLOR="Red"]  If Right(strFilePath, 1) = "\" Then
          strFilePath = strFolderName & strFileName
    Else 'add missing backslash
          strFilePath = strFolderName & "\" & strFileName
    End If
    
    Debug.Print strFilePath[/COLOR]

    'Check file exists
    If [COLOR="Red"]Dir(strFilePath) <> ""[/COLOR] Then
          Call fHandleFile(strFilePath, WIN_NORMAL)
    Else 'file missing . . . show folder
          Shell "C:\WINDOWS\explorer.exe """ & strFolderName & "", vbNormalFocus
    End If

Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.number & " in cmdOpenFolder_Click procedure :             " & _
        Err.description, vbCritical, "Program error"
    Resume Exit_Handler
    
End Sub
 
E

ebbsamsung

Registered User.
Local time
Today, 13:22
Joined
May 22, 2014
Messages
19
Sir Ridders,

First and foremost, allow me to re-post the successful guidance of Sir Ridders.Thank you so much for your patience and sharing your expertise to get the exact code for my db. :)

Anyway, the code was running perfectly, so for those who encounter like this problem, this is what i did with the aide of Sir Ridders.

Maybe this will help you.

1st Part, I made a table that holds the record

Fields Name:
No
DocumentNo
RevisionNo
FileLocation------this hold the path of the file or folder

2nd Part, a continuous form with a record source of the table in 1st part
3rd Part, a button (cmdOpenFolder) in a subform detail section
4th Part, in a button copy the code below and put in "On Click" event

Code: 
Private Sub [COLOR=red]cmdOpenFolder[/COLOR]_Click()

    Dim strFileName As String, strFolderName As String, strFilePath As String
    
   [COLOR=SeaGreen] 'strFileName holds the concatenation of fieds in a subform[/COLOR]
    strFileName = Me.No & "_" & Me.DocumentNo & "_" & Me.RevisionNo & ".pdf"
   [COLOR=seagreen]'strFolderName holds the the path (FileLocation)[/COLOR] 
   strFolderName = Application.HyperlinkPart(FileLocation)
    
    [COLOR=seagreen]'concatenate to get the full folder path
    'check for trailing backslash[/COLOR]
    
    If Right(strFilePath, 1) = "\" Then
        strFilePath = strFolderName & strFileName
        
    Else [COLOR=seagreen]' add missing backslash[/COLOR]
        strFilePath = strFolderName & "\" & strFileName
    
    End If
    
    Debug.Print strFilePath
    
    [COLOR=seagreen]'Check if file exists[/COLOR]
    If Dir(strFilePath) <> "" Then
        Call fHandleFile(strFilePath, WIN_NORMAL)
       [COLOR=seagreen] 'StatusBar 'clear message[/COLOR]
    Else
      [COLOR=seagreen] 'file missing . . . show error message[/COLOR]
       Shell "C:\WINDOWS\explorer.exe """ & strFolderName & "", vbNormalFocus
    End If
   
    
Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " in cmdOpenFolder_Click procedure : " & _
        Err.Description, vbCritical, "Program error"
    Resume Exit_Handler
End Sub
Copy this code to a module:

Code: 
Option Compare Database
Option Explicit

Dim fso As Object

 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

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&

'---------------------------------------------------

Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    [COLOR=SeaGreen]'First try ShellExecute[/COLOR]
    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:
                [COLOR=seagreen]'Try the OpenWith dialog[/COLOR]
                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)
                
Exit_Handler:
    Exit Function
 
isladogs

isladogs

MVP / VIP
Local time
Today, 21:22
Joined
Jan 14, 2017
Messages
18,215
Think you're overdoing the Sir bit .... ;)
Glad its finally working for you....

However you've omitted the following line needed for error handling
Code: 
On Error GoTo Err_Handler
Place it as the 2nd line - above the Dim line

You can make this MUCH more useful by placing the first procedure in a module and changing it to a Public Function so it can be called from anywhere

Code: 
Public Function OpenFileFolder(strFolderName as String, strFileName As String)

On Error GoTo Err_Handler

    Dim strFilePath As String

     'concatenate to get the full folder path
    'check for trailing backslash
    
    If Right(strFilePath, 1) = "\" Then
        strFilePath = strFolderName & strFileName        
    Else ' add missing backslash
        strFilePath = strFolderName & "\" & strFileName    
    End If
    
   ' Debug.Print strFilePath
    
    'Check whether file exists
    If Dir(strFilePath) <> "" Then
        'file exists so open it
        Call fHandleFile(strFilePath, WIN_NORMAL)
    Else
       'file missing . . . open folder instead
       Shell "C:\WINDOWS\explorer.exe """ & strFolderName & "", vbNormalFocus
    End If
   
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & " in OpenFileFolder procedure : " & _
        Err.Description, vbCritical, "Program error"
    Resume Exit_Handler
End Function

Now you can use this repeatedly wherever you like in your database using a single line of code like this:
Code: 
OpenFileFolder "C:\MyFiles\PDF_Files", "ExampleFile.pdf"
 
You must log in or register to reply here.

Similar threads

J
Solved Removing pages in report with Module
Replies
3
Views
326
jazsriel
J
S
Antivirus getting in the way
Replies
2
Views
368
moke123
moke123
G
Help with PDF page number VBA
Replies
0
Views
372
gojets1721
G
smtazulislam
Solved Upload the Path Auto from the TABLE path
Replies
19
Views
992
smtazulislam
smtazulislam
J
Auto Email
Replies
3
Views
678
arnelgp
arnelgp

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom