mike60smart
Registered User.
- Local time
- Today, 08:22
- Joined
- Aug 6, 2017
- Messages
- 2,058
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.
The Code to send the Email is as follows:-
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 FunctionThe 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
