UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Attach And Change Name Of Pdf In Email, Access 2013    
 
   
soggycashew
post Nov 14 2019, 05:33 AM
Post#1



Posts: 371
Joined: 23-April 13
From: WV, USA


Hello, I am currently using a right click in my reports to get a menu for send as attachment. What I'm using works but isn't what I'm after. The attached .pdf uses the name that the report is called and I want to change it for each report possibly by using the reports "Caption", this way each report will be named whatever is in the caption and not what the report is actually called. Below is the module and reports vba used right now.

Module:

CODE
Option Compare Database
Option Explicit

Public Function PrintActiveRptFrm() As String
'============================================================================
======================
'//Code works with right click for print dialog box for my reports.
'============================================================================
======================
    Dim rptCur As Access.Report
    Set rptCur = Screen.ActiveReport

    On Error Resume Next
    DoCmd.SelectObject acReport, rptCur
    DoCmd.RunCommand acCmdPrint

    'Close the report
    CloseAllReports

End Function

Public Function EmailAsPDF()
'============================================================================
======================
'//Code works with right click for my reports
'
'//Reference: Microsoft Outlook 12.0 Object Library
'============================================================================
======================
    On Error GoTo Error_Handler
    Dim objOutlook As Outlook.Application
    Dim objEmail As Outlook.MailItem
    Dim strSubject As String
    Dim strMessageText As String
    Dim rptCur As Access.Report
    Dim AttachmentName As String
    Set rptCur = Screen.ActiveReport

    strSubject = "Superlog Report"
    strMessageText = "Attached is a report from the Superlog database."
                
    Set objOutlook = CreateObject("Outlook.application")
    Set objEmail = objOutlook.CreateItem(olMailItem)
    AttachmentName = SaveOpenReportAsPDF(rptCur.Name)
    'Debug.Print AttachmentName
    With objEmail
        '.To = strgTo
        .Subject = strSubject
        .Body = strMessageText
        .Attachments.Add AttachmentName
        .Display
    End With
    DeleteSavedReport AttachmentName    'Deletes the saved .pdf
    CloseAllReports    'Close Report
Exit_Here:
    Set objOutlook = Nothing
    Exit Function
Error_Handler:
    MsgBox Err & ": " & Err.Description
    CloseAllReports
    Resume Exit_Here
End Function

Public Function SaveOpenReportAsPDF(strReportName As String) As String
'============================================================================
======================
'Create report and save as an attachment to the current record
'============================================================================
======================
    Dim myCurrentDir As String
    Dim myReportOutput As String
    Dim myMessage As String

    On Error GoTo ErrorHandler
    myCurrentDir = CurrentProject.Path & "\"
    myReportOutput = myCurrentDir & strReportName & ".pdf"
    If Dir(myReportOutput) <> "" Then    ' the file already exists--delete it first.
        VBA.SetAttr myReportOutput, vbNormal    ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill myReportOutput    ' delete the file.
    End If
    DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, myReportOutput, , , , acExportQualityPrint
    SaveOpenReportAsPDF = myReportOutput
    Exit Function
ErrorHandler:
    MsgBox Error$
End Function

Public Function DeleteSavedReport(FileName As String)
'============================================================================
======================
'//Delete the saved .pdf, Filename is complete path and file name
'============================================================================
======================
    On Error GoTo ErrorHandler
    If Dir(FileName) <> "" Then    ' the file already exists--delete it
        VBA.SetAttr FileName, vbNormal    ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill FileName    ' delete the file.
    End If
ErrorHandler:
    MsgBox Error$
End Function

Public Sub CloseAllReports()
'============================================================================
======================
'//Code used to close the current report
'============================================================================
======================
    Dim rpt As Access.Report
    For Each rpt In Application.Reports
        DoCmd.Close acReport, rpt.Name
    Next rpt
End Sub



Report VBA:

CODE
Private Sub Report_Load()
    CreateReportShortcutMenu
End Sub

Private Sub CreateReportShortcutMenu()
'============================================================================
======================
'//In the Report_Load Event enter CreateReportShortcutMenu then in the reports Property/Shortcut
'   Menu Bar enter the MenuName "vbaShortCutMenu"
'
'//The numbers are Ms Access Control numbers you can download and excel file from MS
'
'//Reference: Microsoft Office 12.0 Object Library
'============================================================================
======================

    Dim MenuName As String
    Dim CB As CommandBar
    Dim CBB As CommandBarButton

    MenuName = "vbaShortCutMenu"

    On Error Resume Next
    Application.CommandBars(MenuName).Delete
    On Error GoTo 0

    'The below code creates the menu I named vbaShortCutMenu
    Set CB = Application.CommandBars.Add(MenuName, msoBarPopup, False, False)
    
    'Adds the Print command.
    Set CBB = CB.Controls.Add(msoControlButton, 15948, , , True)
    CBB.Caption = "Print..."
    CBB.Tag = "Print..."
    CBB.OnAction = "PrintActiveRptFrm"  'Calls a module with EmailAsPDF()
    
    'Adds the Email As .PDF command.
    Set CBB = CB.Controls.Add(msoControlButton, 2188, , , True)
    CBB.Caption = "Send E-mail..."
    CBB.Tag = "Send E-mail..."
    CBB.OnAction = "=EmailAsPDF()"  'Calls a module with EmailAsPDF()
    
    'Adds the Save As .PDF command.
    Set CBB = CB.Controls.Add(msoControlButton, 12499, , , True)
    CBB.Caption = "Save As PDF..."
    
    
    'Adds the Close command.
'    Set CBB = CB.Controls.Add(msoControlButton, 923, , , True)
    'Starts a new group.
'    CBB.BeginGroup = True
    'Change the caption displayed for the control.
'    CBB.Caption = "Close Report"
'    CBB.OnAction = "CloseAllReports"  'Calls a module with CloseAllReports()

    Set CB = Nothing
    Set CBB = Nothing

End Sub


Go to the top of the page
 
June7
post Nov 14 2019, 06:33 AM
Post#2



Posts: 1,019
Joined: 25-January 16



Code can certainly reference report Caption property. Why don't you try it?


--------------------
Attachments Manager is below the edit post window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
DEBUG! DEBUG! DEBUG! http://www.cpearson.com/Excel/DebuggingVBA.aspx
Go to the top of the page
 
Larry Larsen
post Nov 14 2019, 07:12 AM
Post#3


UA Editor + Utterly Certified
Posts: 24,385
Joined: 26-August 02
From: Melton Mowbray,Leicestershire (U.K)


Hi
You can simply reference the property..

CODE
Function GetReportCaption(RptName As String) As String
Static RptCaptions As Collection

    If RptCaptions Is Nothing Then Set RptCaptions = New Collection
    On Error Resume Next
    GetReportCaption = RptCaptions(RptName)
    If Err.Number = 0 Then Exit Function
    On Error GoTo 0

    DoCmd.OpenReport RptName, acViewDesign, , , acHidden
    RptCaptions.Add Reports(RptName).Caption, RptName
    DoCmd.Close acReport, RptName

    GetReportCaption = RptCaptions(RptName)
End Function


Immediate Window:
? getReportCaption("rpt_ExecutiveSummary")
Executive Summary Report

Just as a test this added line did change the caption.
CODE
  DoCmd.OpenReport RptName, acViewDesign, , , acHidden
    Reports(RptName).Caption = "I have now been changed.."  '<< This line..
    RptCaptions.Add Reports(RptName).Caption, RptName
    DoCmd.Close acReport, RptName


Let's also bear in mind renaming the report with details of what's in the caption property has to conform to a readable object format.

No spaces or other characters that would invalidate the required report name..

HTH's
thumbup.gif
Reason for edit: additional testing code..

--------------------
"Time...We have exactly the same number of hours per day that were given to Helen Keller, Pasteur, Michaelangelo, Mother Teresa, Leonardo da Vinci, Thomas Jefferson, and Albert Einstein"
H. Jackson Brown
Go to the top of the page
 
soggycashew
post Nov 14 2019, 09:00 AM
Post#4



Posts: 371
Joined: 23-April 13
From: WV, USA


Larry, I saw that code on stack yesterday and tried it with no luck. All I'm looking to do is grab the active reports caption and use it instead of the actual (.Name). I searched the web and found no solutions.

Something like....


Set rptCur = Screen.ActiveReport

ActiveReport = rptCur.Name
ReportCaption = ActiveReport.Caption
Go to the top of the page
 
Larry Larsen
post Nov 14 2019, 09:58 AM
Post#5


UA Editor + Utterly Certified
Posts: 24,385
Joined: 26-August 02
From: Melton Mowbray,Leicestershire (U.K)


Hi
I'm going to ask the question with regards to the naming of the reports, why don't you rename them to what you want to see as a report name (object)..??

Or prefix the report name eg: rpt_BigReport

Adjust with code to omit the "rpt_"

thumbup.gif iconfused.gif

--------------------
"Time...We have exactly the same number of hours per day that were given to Helen Keller, Pasteur, Michaelangelo, Mother Teresa, Leonardo da Vinci, Thomas Jefferson, and Albert Einstein"
H. Jackson Brown
Go to the top of the page
 
soggycashew
post Nov 14 2019, 02:58 PM
Post#6



Posts: 371
Joined: 23-April 13
From: WV, USA


Never thought of that.... Came up with.

CODE
myReportOutput = myCurrentDir & Mid(strReportName, 5) & ".pdf"



Thanks,
Go to the top of the page
 
Larry Larsen
post Nov 14 2019, 04:02 PM
Post#7


UA Editor + Utterly Certified
Posts: 24,385
Joined: 26-August 02
From: Melton Mowbray,Leicestershire (U.K)


yw.gif

--------------------
"Time...We have exactly the same number of hours per day that were given to Helen Keller, Pasteur, Michaelangelo, Mother Teresa, Leonardo da Vinci, Thomas Jefferson, and Albert Einstein"
H. Jackson Brown
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    11th December 2019 - 11:10 PM