Choose a Folder (1 Viewer)

mike60smart

Registered User.
Joined
Aug 6, 2017
Messages
1,932
I have an On Click Event which saves a PDF file of a Report which is being sent as an Attachment in an Email Message.

Is it possible to use the following code provided by Carda Consultants Inc. to browse to a folder to store the PDF?

Any help appreciated.

Code:
'FSBrowse (File System Browse) allows the operator to browse for a file/folder.
'  strStart specifies where the process should start the browser.
'  lngType specifies the MsoFileDialogType to use.
'           msoFileDialogOpen           1   Open dialog box.
'           msoFileDialogSaveAs         2   Save As dialog box.
'           msoFileDialogFilePicker     3   File picker dialog box.
'           msoFileDialogFolderPicker   4   Folder picker dialog box.
'  strPattern specifies which FileType(s) should be included.
'
'    Dim sFile                 As String
'    sFile = FSBrowse("", msoFileDialogFilePicker, "MS Excel,*.XLSX; *.XLSM; *.XLS")
'    If sFile <> "" Then Me.txt_FinData_Src = sFile
'***** Requires a Reference to the 'Microsoft Office XX.X Object Library *****
Public Function FSBrowse(Optional strStart As String = "", _
                         Optional lngType As MsoFileDialogType = _
                         msoFileDialogFolderPicker, _
                         Optional strPattern As String = "All Files,*.*" _
                         ) As String
    Dim varEntry              As Variant

    FSBrowse = ""
    With Application.FileDialog(dialogType:=lngType)
        'Set the title to match the type used from the list
        .Title = "Browse for "
        Select Case lngType
            Case msoFileDialogOpen
                .Title = .Title & "File to open"
            Case msoFileDialogSaveAs
                .Title = .Title & "File to SaveAs"
            Case msoFileDialogFilePicker
                .Title = .Title & "File"
            Case msoFileDialogFolderPicker
                .Title = .Title & "Folder"
        End Select
        If lngType <> msoFileDialogFolderPicker Then
            'Reset then add filter patterns separated by tildes (~) where
            '  multiple extensions are separated by semi-colons (;) and the
            '  description is separated from them by a comma (,).
            '  Example strPattern :
            '  "MS Access,*.ACCDB; *.MDB~MS Excel,*.XLSX; *.XLSM; *.XLS"
            Call .Filters.Clear
            For Each varEntry In Split(strPattern, "~")
                Call .Filters.Add(Description:=Split(varEntry, ",")(0), _
                                  Extensions:=Split(varEntry, ",")(1))
            Next varEntry
        End If
        'Set some default settings
        .InitialFileName = strStart
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        'Only return a value from the FileDialog if not cancelled.
        If .Show Then FSBrowse = .SelectedItems(1)
    End With
End Function

The Code to send the Email is as follows:-

Code:
30        MsgBox "A Copy of the PDF will be saved to the C Drive Agents EMails Folder", vbInformation
          Dim strSQL As String
          Dim strDocname As String
          Dim strWhere As String
          Dim strTo As String
          Dim strMsgBody As String
          Dim strSubject As String
          
40        strDocname = "AgentSettlement"
50        strWhere = "[AgentID]=" & Me.id
60        strSubject = "Settlement"
70        strTo = Me.AgenteMailP

80        strMsgBody = DLookup("MsgBody", "qrySettlements")
90        If Me.Dirty Then Me.Dirty = False ' force a save

100       If Dir("c:\Agent Emails", vbDirectory) = "" Then MkDir "c:\Agent Emails"
          Dim OutputFile As String
110       If Me.AgentPaid = True Then

120       OutputFile = "C:\Agent Emails\" & [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- AgentSettlement.pdf"
130       DoCmd.OutputTo acOutputReport, "AgentSettlement", acFormatPDF, OutputFile, False
140       DoCmd.OpenReport strDocname, acPreview, , strWhere
150       DoCmd.SendObject acSendReport, "AgentSettlement", acFormatPDF, strTo, , , strSubject, strMsgBody, True
160       End If
 
Sure, just set your OutputFIle variable to the result returned by that and then add the file name.
 
Sure, just set your OutputFIle variable to the result returned by that and then add the file name.
Hi pBaldy

My current Outputfile is:-

Code:
OutputFile = "C:\Agent Emails\" & [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- AgentSettlement.pdf"

This just the location where the file is being saved.

I am not understanding how to set the variable so that a File Picker Dialog opens ?
 
Mike:
Here's a sample
Code:
' ----------------------------------------------------------------
' Procedure Name: SaveFileToSelectedFolder
' Purpose: Routine to use FileDialogPicker to save a file
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jack
' Date: 22-Mar-23
' Related: https://www.access-programmers.co.uk/forums/threads/choose-a-folder.327069/#post-1869955
' ----------------------------------------------------------------
Sub SaveFileToSelectedFolder()
10        On Error GoTo SaveFileToSelectedFolder_Error
          Dim fd As filedialog
          Dim selectedFolder As String
          
          ' Create a FileDialog object as a Folder Picker dialog box.
20        Set fd = Application.filedialog(msoFileDialogFolderPicker)
          
          ' Show the Folder Picker dialog box.
30        If fd.Show = -1 Then
              ' User has selected a folder, so set the selectedFolder variable to the path of the selected folder.
40            selectedFolder = fd.SelectedItems(1)
              ' Save the file to the selected folder.
50            DoCmd.OutputTo acReport, "rpt_ancestor", acFormatPDF, selectedFolder _
                  & "\SampleFileName" & "Mar212023_mikesmart" & ".pdf"
60            Debug.Print "File saved to: " & selectedFolder & "   " & Now
70        Else
              ' User has cancelled the Folder Picker dialog box.
80            MsgBox "No folder was selected."
90        End If
        
          ' Set the FileDialog object to Nothing.
100       Set fd = Nothing
          
110       On Error GoTo 0
SaveFileToSelectedFolder_Exit:
120       Exit Sub

SaveFileToSelectedFolder_Error:

130       Debug.Print "Error " & Err.Number & " (" & Err.Description & "), line " & Erl & " in Procedure SaveFileToSelectedFolder" _
              & "  Module  ZZ_ScratchPad "
140       GoTo SaveFileToSelectedFolder_Exit
End Sub

Result message:
File saved to: C:\Users\JP\Documents\TestResize 22-Mar-23 8:17:10 AM

SampleMikeSmart.png
 
Hi Jack

So Do I create a Module for this Procedure ?

Then add the DoCmd Lines to my current VB ?

Code:
50            DoCmd.OutputTo acReport, "rpt_ancestor", acFormatPDF, selectedFolder _
                  & "\SampleFileName" & "Mar212023_mikesmart" & ".pdf"
60            Debug.Print "File saved to: " & selectedFolder & "   " & Now
 
Mike:
Here's a sample
Code:
' ----------------------------------------------------------------
' Procedure Name: SaveFileToSelectedFolder
' Purpose: Routine to use FileDialogPicker to save a file
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jack
' Date: 22-Mar-23
' Related: https://www.access-programmers.co.uk/forums/threads/choose-a-folder.327069/#post-1869955
' ----------------------------------------------------------------
Sub SaveFileToSelectedFolder()
10        On Error GoTo SaveFileToSelectedFolder_Error
          Dim fd As filedialog
          Dim selectedFolder As String
         
          ' Create a FileDialog object as a Folder Picker dialog box.
20        Set fd = Application.filedialog(msoFileDialogFolderPicker)
         
          ' Show the Folder Picker dialog box.
30        If fd.Show = -1 Then
              ' User has selected a folder, so set the selectedFolder variable to the path of the selected folder.
40            selectedFolder = fd.SelectedItems(1)
              ' Save the file to the selected folder.
50            DoCmd.OutputTo acReport, "rpt_ancestor", acFormatPDF, selectedFolder _
                  & "\SampleFileName" & "Mar212023_mikesmart" & ".pdf"
60            Debug.Print "File saved to: " & selectedFolder & "   " & Now
70        Else
              ' User has cancelled the Folder Picker dialog box.
80            MsgBox "No folder was selected."
90        End If
       
          ' Set the FileDialog object to Nothing.
100       Set fd = Nothing
         
110       On Error GoTo 0
SaveFileToSelectedFolder_Exit:
120       Exit Sub

SaveFileToSelectedFolder_Error:

130       Debug.Print "Error " & Err.Number & " (" & Err.Description & "), line " & Erl & " in Procedure SaveFileToSelectedFolder" _
              & "  Module  ZZ_ScratchPad "
140       GoTo SaveFileToSelectedFolder_Exit
End Sub

Result message:
File saved to: C:\Users\JP\Documents\TestResize 22-Mar-23 8:17:10 AM

View attachment 107078
Hi Jack

OK Please ignore my last post as I managed to work out where to modify my Code.

It pops up with the File Dialog window and populates with the current Report Name.

Is there any way to prefix the Report Name so that it saves as follows:-

133875 22032023 ReportName

133875 being Load Number
22032023 being Date

Many thanks for getting me this far.
 
If you use the FileSystemObject, there is a way to ask it to "pick apart" your file specification and then later reassemble it after you have modified one of the parts.


From that link, you can browse the table of contents on the left-hand side for various file system Methods including the GETxxx functions that extract various parts of a fully qualified file specification (FQFS). So... extract the parts. Edit the part you wanted to change by concatenating a string for that portion. Avoid punctuation that would confuse the FQFS parser, like extra dots or non-printing characters. Then use simple string concatenation that will reconstitute the FQFS for you.
 
Hi Jack

OK Please ignore my last post as I managed to work out where to modify my Code.

It pops up with the File Dialog window and populates with the current Report Name.

Is there any way to prefix the Report Name so that it saves as follows:-

133875 22032023 ReportName

133875 being Load Number
22032023 being Date

Many thanks for getting me this far.

You haven't shown how you're doing it, but I was expecting something like:

OutputFile = FunctionCallHereToGetFolderPath
OutputFile = OutputFile & [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- AgentSettlement.pdf"

You may have to add a trailing "\" if the function call doesn't include one.
 
Hi Paul

That was the final bit of the puzzle.

Now works a treat.

Many thanks yet again.
 
You haven't shown how you're doing it, but I was expecting something like:

OutputFile = FunctionCallHereToGetFolderPath
OutputFile = OutputFile & [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- AgentSettlement.pdf"

You may have to add a trailing "\" if the function call doesn't include one.
Hi Paul
Well I spoke too soon

I keep getting the following error:-

The lines of Code of interest are as follows;

The Code opens the Report and the Sleep Event pauses the Code while the Report Content is
checked.
It then generates the error noted.

Any help appreciated.
Code:
100       DoCmd.OpenReport strDocname, acViewReport, , strWhere
110       DoCmd.Maximize

120       Sleep 10000   'Pause execution for 10 seconds

130       OutputFile = FunctionCallHereToGetFolderPath
140       OutputFile = OutputFile & [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- AgentSettlement.pdf"

150       DoCmd.SendObject acSendReport, OutputFile, acFormatPDF, strTo, , , strSubject, strMsgBody, True
 

Attachments

  • Error.png
    Error.png
    8.3 KB · Views: 76
Mike,
My post and sample were intended to simply show how to use FileDialog
to browse to a folder to store the PDF. My sample worked to select a folder and save the pdf.
You seem to be doing more now than in your initial post.
I have been away most of the day.
 
Mike,
My post and sample were intended to simply show how to use FileDialog
to browse to a folder to store the PDF.
I have been away most of the day.
Hi Jack

Yes and your example did just what I wanted.
The op then asked if it could be modified to show the "Load Number - Date - ReportName" as the Filename.

Paul kindly stepped up and his suggestion works but for some reason I am now getting the error reported in my last post.
 
To my knowledge you can't use SendObject to attach an existing file. I typically use Outlook automation to send an email with an existing file attached.
 
I just noticed you're not outputting the report anymore. You can use SendObject to send the report (strDocname) with the default name or output it with your desired name and send it via another method.
 
I just noticed you're not outputting the report anymore. You can use SendObject to send the report (strDocname) with the default name or output it with your desired name and send it via another method.
Hi Paul

I just checked this before your post and it will send the EMail but it misses out
the option to Save to a Folder ?

Code:
100       DoCmd.OpenReport strDocname, acViewReport, , strWhere
110       DoCmd.Maximize

120       Sleep 10000   'Pause execution for 10 seconds

130       OutputFile = FunctionCallHereToGetFolderPath
140       OutputFile = OutputFile & [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- AgentSettlement.pdf"

150       DoCmd.SendObject acSendReport, "AgentSettlement", acFormatPDF, strTo, , , strSubject, strMsgBody, True
 
I don't believe there's any way to save the file sent via SendObject, other than it being in your sent items email folder. If you want it both saved and sent, you're looking at OutputTo and then sending via Outlook automation, CDO, or perhaps some other method.
 
I don't believe there's any way to save the file sent via SendObject, other than it being in your sent items email folder. If you want it both saved and sent, you're looking at OutputTo and then sending via Outlook automation, CDO, or perhaps some other method.
Hi Paul & Jack

Change of plan.

We now display the Report in Report View.

Then on the Report we have a Command Button with the following OnClick Event.

Code:
Private Sub cmdSave_Click()

10        On Error GoTo cmdSave_Click_Error
        
          Dim strDocname As String
          Dim strWhere As String
          
          Dim SelectedFolder As String
          Dim FunctionCallHereToGetFolderPath As String
          Dim OutputFile As String
          
20        strDocname = "AgentSettlement"
30        strWhere = "[AgentID]=" & Me.ID


40        OutputFile = FunctionCallHereToGetFolderPath
50        OutputFile = [LoadNumber] & " - " & Format(Date, "mmddyyyy") & "- [DocName].pdf"
          

          
60        On Error GoTo 0
70        Exit Sub

cmdSave_Click_Error:

80        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdSave_Click, line " & Erl & "."

End Sub

Currently it does not do anything and I get no errors.

Can you help to show me where I am going wrong?

Any help appreciated.
 
Mike,
Not sure I'm following the details.
I added a button in the header of the report.
button name btnSave
click event
Code:
Private Sub btnSave_Click()
    Call SaveFileToSelectedFolder
End Sub

SaveFileToSelectedFolder is routine I provided yesterday.

I have attached a very rough gif in the zip showing things.
 

Attachments

Last edited:

Users who are viewing this thread

Top Bottom