Set Paper Size

[Rayyan91]

Hello everyone,

I have a monthly report I export as a PDF and email it to some ppl. It is a huge report and I am trying to export the report in a Ledger paper size, but I can't get this done. I would like your help on this,if possible.

This is the VBA code I have so far

Public Function EmailLastMonthScrapReport()   
     
    On Local Error GoTo Some_Err
  
    Dim MyDB As Database
    Dim MyRS As Recordset
    Dim MyRpt As Recordset
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim TheAddress As String
    Dim RecordID As String
    Dim lstRptName As String
    Dim strDir As String
    Dim strFile As String
    Dim AttachmentPath As String
    Dim blSkip As Boolean
    Dim strAddress As String
    Dim MyPosn As Integer
    Dim strLen As Integer
    Dim MultiEmailFlag As Boolean
    
    
    
    ' Create the Outlook session to allow creating the emails
    Set objOutlook = CreateObject("Outlook.Application")


    'Open Report to allow it to be filtered
    DoCmd.OpenReport "rptNewScrapDetReport", acViewPreview
    Reports("rptNewScrapDetReport").Printer.PaperSize = acPRPSLedger


    
    ' Set directories and file names for file archiving and storage
    ' Directory to place the PDF files that are to be printed
    strDir = "Y:\Scrap Analysis\zz Auto Reports Monthly\"
    ' Name of file to create
    strFile = Format(Date - 28, "YYYY") & " " & Format(Date - 28, "mmmm") & ".pdf"
    AttachmentPath = strDir & strFile


    ' CREATE PDF REPORT HERE
    Dim blRet As Boolean
    blRet = ConvertReportToPDF("rptNewScrapDetReport", vbNullString, _
    strDir & strFile, False, True, 150, "", "", 0, 0, 0)


    'Close Report to allow it to be filtered
 'End With
    DoCmd.Close acReport, "rptNewScrapDetReport"
        
    ' Create the e-mail message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)


    With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add("xxx@xxx.com")
        objOutlookRecip.Type = olTo
        Set objOutlookRecip = .Recipients.Add("xxx@xxx.com")
       
        
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .Importance = olImportanceHigh  'High importance
        .Subject = "Scrap Report for " & Format(Date - 28, "mmmm") & " " & Format(Date - 28, "YYYY")
'        .Body = "Attached is..."
'        .Body = .Body & " ..."
'        .Body = .Body & Chr(13)
'        .Body = .Body & Chr(13)
        
        'Add the attachment to the e-mail message.
        If Not IsMissing(AttachmentPath) Then
            Set objOutlookAttach = .Attachments.Add(AttachmentPath)
        End If
             
        ' Resolve the name of each Recipient.
        For Each objOutlookRecip In .Recipients
        objOutlookRecip.Resolve
        If Not objOutlookRecip.Resolve Then
            objOutlookMsg.Display
        End If
        Next
                      
                      
        ' If we have a valid email address for that supplier, then send message, otherwise,
        ' add in info for me to know we're missing something.
        If (IsNull(objOutlookRecip)) Then
            MsgBox ("No valid email address")
        Else
            .Send
        End If
    End With




' All done.  Clean up
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing


Some_Err:
  'MousePointer = 0
'  MsgBox "Error (" & CStr(Err.Number) & ") " & Err.Description, _
'  vbExclamation, "Error!"


Err_EmailLastMonthScrapReport:
'    MsgBox Err.Description
'    Resume EmailScorecards_Click


    
End Function

 

[Rayyan91]

Any thoughts on this ?!

 

[xenou]

your code calls a function named ConvertReportToPDF(). What is that function? How does it work?

 

[Rayyan91]

your code calls a function named ConvertReportToPDF(). What is that function? How does it work?

Yes It calls another function stored in another Module.

Public Function ConvertReportToPDF( _Optional RptName As String = "", _
Optional SnapshotName As String = "", _
Optional OutputPDFname As String = "", _
Optional ShowSaveFileDialog As Boolean = False, _
Optional StartPDFViewer As Boolean = True, _
Optional CompressionLevel As Long = 0, _
Optional PasswordOpen As String = "", _
Optional PasswordOwner As String = "", _
Optional PasswordRestrictions As Long = 0, _
Optional PDFNoFontEmbedding As Long = 0, _
Optional PDFUnicodeFlags As Long = 0 _
) As Boolean




' RptName is the name of a report contained within this MDB
' SnapshotName is the name of an existing Snapshot file
' OutputPDFname is the name you select for the output PDF file
' ShowSaveFileDialog is a boolean param to specify whether or not to display
' the standard windows File Dialog window to select an exisiting Snapshot file
' default process of embedding all fonts in the output PDF. If you are
' using ONLY - any of the standard Windows fonts
' using ONLY - any of the standard 14 Fonts natively supported by the PDF spec
'independent whether they're embedded or not.


Dim s As String
Dim blRet As Boolean
' Let's see if the DynaPDF.DLL is available.
blRet = LoadLib()
If blRet = False Then
    ' Cannot find DynaPDF.dll or StrStorage.dll file
    Exit Function
End If


On Error GoTo ERR_CREATSNAP


Dim strPath  As String
Dim strPathandFileName  As String
Dim strEMFUncompressed As String


Dim sOutFile As String
Dim lngRet As Long


' Init our string buffer
strPath = Space(Pathlen)


'Save the ReportName to a local var
mReportName = RptName


If Len(mUncompressedSnapFile & vbNullString) > 0 Then
    Kill mUncompressedSnapFile
    mUncompressedSnapFile = ""
End If


' If we have been passed the name of a Snapshot file then
' skip the Snapshot creation process below
If Len(SnapshotName & vbNullString) = 0 Then
      
    ' Make sure we were passed a ReportName
    If Len(RptName & vbNullString) = 0 Then
        ' No valid parameters - FAIL AND EXIT!!
        ConvertReportToPDF = ""
        Exit Function
    End If
        
    ' Get the Systems Temp path
    ' Returns Length of path(num characters in path)
    lngRet = GetTempPath(Pathlen, strPath)
    ' Chop off NULLS and trailing "\"
    strPath = Left(strPath, lngRet) & Chr(0)
    
    ' Now need a unique Filename
    ' locked from a previous aborted attemp.
    ' Needs more work!
    strPathandFileName = GetUniqueFilename(strPath, "SNP" & Chr(0), "snp")
    
    ' Export the selected Report to SnapShot format
    DoCmd.OutputTo acOutputReport, RptName, "SnapshotFormat(*.snp)", _
       strPathandFileName
    ' Make sure the process has time to complete
    DoEvents


Else
    strPathandFileName = SnapshotName
 
End If


' Let's decompress into same filename but change type to ".tmp"
'strEMFUncompressed = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
'strEMFUncompressed = strEMFUncompressed & "tmp"
Dim sPath As String * 512
lngRet = GetTempPath(512, sPath)


strEMFUncompressed = GetUniqueFilename(sPath, "SNP", "tmp")


lngRet = SetupDecompressOrCopyFile(strPathandFileName, strEMFUncompressed, 0&)


If lngRet <> 0 Then
    Err.Raise vbObjectError + 525, "ConvertReportToPDF.SetupDecompressOrCopyFile", _
    "Sorry...cannot Decompress SnapShot File" & vbCrLf & _
    "Please select a different Report to Export"
End If


' Set our uncompressed SnapShot file name var
mUncompressedSnapFile = strEMFUncompressed


' Remember to Cleanup our Temp SnapShot File if we were NOT passed the
' Snapshot file as the optional param
If Len(SnapshotName & vbNullString) = 0 Then
    Kill strPathandFileName
End If




' Do we name output file the same as the input file name
' and simply change the file extension to .PDF or
' do we show the File Save Dialog
If ShowSaveFileDialog = False Then


    ' let's decompress into same filename but change type to ".tmp"
    ' But first let's see if we were passed an output PDF file name
    If Len(OutputPDFname & vbNullString) = 0 Then
        sOutFile = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
        sOutFile = sOutFile & "PDF"
    Else
        sOutFile = OutputPDFname
    End If


Else
    ' Call File Save Dialog
    sOutFile = fFileDialog()
    If Len(sOutFile & vbNullString) = 0 Then
        Exit Function
    End If


End If


' Call our function in the StrStorage DLL
' Note the Compression and Password params are not hooked up yet.
blRet = ConvertUncompressedSnapshot(mUncompressedSnapFile, sOutFile, _
CompressionLevel, PasswordOpen, PasswordOwner, PasswordRestrictions, PDFNoFontEmbedding, PDFUnicodeFlags)


If blRet = False Then
Err.Raise vbObjectError + 526, "ConvertReportToPDF.ConvertUncompressedSnaphot", _
    "Sorry...damaged SnapShot File" & vbCrLf & _
    "Please select a different Report to Export"
End If


' Do we open new PDF in registered PDF viewer on this system?
If StartPDFViewer = True Then
 ShellExecuteA Application.hWndAccessApp, "open", sOutFile, vbNullString, vbNullString, 1
End If


' Success
ConvertReportToPDF = True




EXIT_CREATESNAP:


' Let's kill any existing Temp SnapShot file
'If Len(mUncompressedSnapFile & vbNullString) > 0 Then
     On Error Resume Next
   Kill mUncompressedSnapFile
    mUncompressedSnapFile = ""
'End If


' If we aready loaded then free the library
If hLibStrStorage <> 0 Then
    hLibStrStorage = FreeLibrary(hLibStrStorage)
End If


If hLibDynaPDF <> 0 Then
    hLibDynaPDF = FreeLibrary(hLibDynaPDF)
End If


Exit Function


ERR_CREATSNAP:
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
mUncompressedSnapFile = ""
ConvertReportToPDF = False
Resume EXIT_CREATESNAP


End Function

 

[xenou]

I don't see anything that would suggest paper size is an option with this method of conversion to pdf.