Wrox Programmer Forums
|
Access VBA Discuss using VBA for Access programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old February 22nd, 2007, 06:49 PM
Authorized User
 
Join Date: Oct 2006
Posts: 12
Thanks: 0
Thanked 0 Times in 0 Posts
Default Print to PDF from Access

Does anyone have vb or vba code for creating a pdf file from an MS Access report and that will save the name of the pdf file with out prompting the user for anything? I already know how to specify the name and location using vba code.

thanks in advance,
Donrafeal
 
Old February 23rd, 2007, 10:41 PM
Authorized User
 
Join Date: Jul 2004
Posts: 30
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Its been a while since i've done this but try this. You might have to tweak it a little, but it does work.

-make sure you have your outlook library referenced


1) In the report properties - change the Caption to the name of your report. When you print your report to the distiller printer, adobe will pickup the caption as the name of your report. For example, if you enter "MyNewReport" in the caption (under the report properties), then adobe will create a pdf named MyNewReport.pdf




2) Somewhere in the pdf writer, you will have to set the default path to where you want your pdf's saved. I can't remember where these setting are but paly around adobe to see where you can set this property. I know it there, but it's been a while sine I've done this.




3) On the click event of your command button, add the text below.

Dim appOutlook As New Outlook.Application
Dim msg As Outlook.MailItem

'Save orig printer default setting
PtrType = DefaultPrinterName

'chg defualt printer to Distiller
ufnSetDefaultPrinter ("Acrobat Distiller")

'print your report to the distiller (at the default path set in adobe)
DoCmd.OpenReport "Your_Report", acViewNormal
DoEvents

 'Create new mail message and send to contacts
   Set msg = appOutlook.CreateItem(olMailItem)
   With msg
      .To = "EmailAddress.com"
      .Subject = "Test Data"
      .Body = "See attached"
      .BCC = "None.com"
      .Attachments.Add "C:\MyNewRport.pdf" '(Add the path where document is located - this is the default path you set in adobe)
      .Send
   End With


'Reset to orig default printer
ufnSetDefaultPrinter (PtrType)




4) Create a module and add

Public PtrType As String 'this string has to be public




5) Create another module named PrinterAPI and add

Option Compare Database
Option Explicit


'API functions
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function OpenPrinter Lib _
   "winspool.drv" Alias "OpenPrinterA" (ByVal _
   pPrinterName As String, phPrn As Long, _
   pDefault As Any) As Long
Private Declare Function GetPrinter Lib _
   "winspool.drv" Alias "GetPrinterA" (ByVal _
   hPrinter As Long, ByVal Level As Long, _
   pPrinter As Any, ByVal cbBuf As Long, _
   pcbNeeded As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long
Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" (ByVal pszPrinter As String) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal Flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Any, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function GetDefaultPrinter Lib "winspool.drv" Alias "GetDefaultPrinterA" (ByVal pszBuffer As String, pcchBuffer As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long

'Global variables needed for API functions
Private Const ERROR_INSUFFICIENT_BUFFER = 122&
Private Const PRINTER_ATTRIBUTE_DEFAULT As Long = &H4
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_SETTINGCHANGE = &H1A
' SendMessageTimeout values
Private Const SMTO_NORMAL = &H0
' dwPlatformId defines:
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
' Used to indicate what to enumerate
Private Const PRINTER_ENUM_DEFAULT As Long = &H1


' Some calls need to know OS version
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Sub test()
    If ufnSetDefaultPrinter("HP LaserJet 5M - LPT 3") Then
        MsgBox "It worked!"
    Else
        MsgBox "Failure!"
    End If
End Sub


Function ufnSetDefaultPrinter(ByVal m_DevName As String) As Boolean
   Dim os As OSVERSIONINFO

    'm_DevName = NewPrinter 'currently "HP LaserJet 5M - LPT 3"

   ' Fork based on what OS we're running on...
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)
   Select Case os.dwPlatformId
      Case VER_PLATFORM_WIN32_WINDOWS '95/98/ME
         Call DefaultPrinterSet9x(m_DevName)
        Case VER_PLATFORM_WIN32_NT
         Call DefaultPrinterSetNT(os.dwMajorVersion, m_DevName)
   End Select

   ' Return results based on test in IsDefault.
   'Me.Refresh
   ufnSetDefaultPrinter = IsDefault(m_DevName)
End Function



Private Sub DefaultPrinterSet9x(m_DevName As String)
   Dim hPrn As Long
   Dim BytesNeeded As Long
   Dim Buffer() As Byte
   Dim BytesUsed As Long
   Dim Attributes As Long

   ' Get handle to printer.
   Call OpenPrinter(m_DevName, hPrn, ByVal 0&)
   If hPrn Then
      ' Call once to get proper buffer size.
      Call GetPrinter(hPrn, 2, ByVal 0&, 0, BytesNeeded)
      If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
         ' Size buffer and get printer data.
         ReDim Buffer(0 To BytesNeeded - 1) As Byte
         If GetPrinter(hPrn, 2, Buffer(0), BytesNeeded, BytesUsed) Then
            ' Set default printer attribute for this printer...
            ' Attributes is the 14th element in structure
            Const AttribOffset As Long = 13 * 4&
            Call CopyMemory(Attributes, Buffer(AttribOffset), 4&)
            Attributes = Attributes Or PRINTER_ATTRIBUTE_DEFAULT
            Call CopyMemory(Buffer(AttribOffset), Attributes, 4&)
            ' Send back updated structure.
            If SetPrinter(hPrn, 2, Buffer(0), 0) Then
               ' Alert all other running applications,
               ' giving each 1/2 second to react.
               Call SettingChangeAlert(500)
            End If
         End If
      End If
      Call ClosePrinter(hPrn)
   End If


End Sub




Private Sub DefaultPrinterSetNT(ByVal MajorVersion As Long, ByVal m_DevName As String)
    Dim os As OSVERSIONINFO
    Dim BufSize As Long
    Dim pPrinterName As Long
    Dim Result As String
    Dim comma As Long

    ' Use either SetDefaultPrinter (2k+) or WIN.INI (NT4).
    If MajorVersion >= 5 Then
        ' Almost so easy as to be boring. <g>
        Call SetDefaultPrinter(m_DevName)

    Else ' (NT4 or less)
        ' Create satisfactory buffer.
        BufSize = 1024
        Result = Space$(BufSize)
        ' In NT, the old WIN.INI [PrinterPorts] section is mapped to
        ' HKCU\Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts
        ' and we can just use GetProfileString to extract!
        ' Returns: "driver name,port,timeout1,timeout2"
        If GetProfileString("PrinterPorts", ByVal m_DevName, "", Result, _
            BufSize) Then
            ' Find 2nd comma and truncate
            comma = InStr(Result, ",")
            comma = InStr(comma + 1, Result, ",")
            If comma Then
                Result = Left$(Result, comma - 1)
                ' Prepend devname and write to registry.
                Result = m_DevName & "," & Result
                Call WriteProfileString("Windows", "device", Result)
                ' Alert all other running applications,
                ' giving each 1/2 second to react.
                Call SettingChangeAlert(500)
            End If
        End If
    End If
End Sub


Private Sub SettingChangeAlert(Optional ByVal Delay As Long = 500)
   ' Send out alert to notify all other running applications
   ' that a system setting has been updated.
   Call SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, _
                           0, 0, SMTO_NORMAL, Delay, ByVal 0&)
End Sub



Public Property Get IsDefault(m_DevName As String) As Boolean
   Dim DefPrn As String
   ' PRINTER_ATTRIBUTE_DEFAULT only works to *set* default.
   DefPrn = DefaultPrinterName
   IsDefault = (UCase$(DefPrn) = UCase$(m_DevName))

End Property

Function DefaultPrinterName() As String
   ' HOWTO: Retrieve and Set the Default Printer in Windows
   ' http://support.microsoft.com/support.../q246/7/72.asp
   ' HOWTO: Get and Set the Default Printer in Windows
   ' http://support.microsoft.com/support.../q135/3/87.asp
   Dim os As OSVERSIONINFO
   Dim Buffer() As Byte
   Dim BufSize As Long
   Dim pPrinterName As Long
   Dim Returned As Long
   Dim Result As String

   ' Get OS version info, so we know which way to fork.
   os.dwOSVersionInfoSize = Len(os)
   Call GetVersionEx(os)

   If os.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '95/98/ME
      ' Determine how big the buffer needs to be
      Call EnumPrinters(PRINTER_ENUM_DEFAULT, vbNullString, 2, ByVal 0&, 0, BufSize, Returned)

      If BufSize > 0 Then
         ' Size buffer accordingly
         ReDim Buffer(0 To BufSize - 1) As Byte
         ' Call again to retrieve needed info
         Call EnumPrinters(PRINTER_ENUM_DEFAULT, vbNullString, 2, Buffer(0), BufSize, BufSize, Returned)
         ' A pointer to the default printer name is
         ' returned at the 5th byte in the buffer.
         Call CopyMemory(pPrinterName, Buffer(4), 4)

         Result = PointerToStringA(pPrinterName)
      End If

   ElseIf os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
      ' Create satisfactory buffer.
      BufSize = 1024
      Result = Space$(BufSize)

      ' Use either GetDefaultPrinter (2k+) or WIN.INI (NT4).
      If os.dwMajorVersion >= 5 Then
         If GetDefaultPrinter(Result, BufSize) Then
            ' Truncate at first NULL
            Result = Left$(Result, InStr(Result, vbNullChar) - 1)
         End If
      Else 'NT4 or less
         ' The old WIN.INI [Windows] section is mapped to
         ' HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows
         ' and we can just use GetProfileString to extract!
         ' Returns: "printer name,driver name,port"
         If GetProfileString("Windows", ByVal "device", "", Result, BufSize) Then
            ' Truncate buffer at end of name.
            Result = Left$(Result, InStr(Result, ",") - 1)
         End If
      End If
   End If


   ' Return default printer name.
   DefaultPrinterName = Result

End Function


Private Function PointerToStringA(ByVal lpStringA As Long) As String
   Dim Buffer() As Byte
   Dim nLen As Long

   If lpStringA Then
      nLen = lstrlenA(ByVal lpStringA)
      If nLen Then
         ReDim Buffer(0 To (nLen - 1)) As Byte
         CopyMemory Buffer(0), ByVal lpStringA, nLen
         PointerToStringA = StrConv(Buffer, vbUnicode)
      End If
   End If


End Function


 
Old February 24th, 2007, 11:35 AM
Authorized User
 
Join Date: Oct 2006
Posts: 12
Thanks: 0
Thanked 0 Times in 0 Posts
Default

thanks, I'll give it a try. Thats a lot of code to try to get to work but it is worth it if it does work. Seems strange that you have to use the Outlook application object though.

thanks,
donrafeal7

 
Old February 24th, 2007, 10:05 PM
Authorized User
 
Join Date: Jul 2004
Posts: 30
Thanks: 0
Thanked 0 Times in 0 Posts
Default

You can omit the outlook code - I had to use it for emailing pdf's

 
Old February 25th, 2007, 12:23 AM
Authorized User
 
Join Date: Oct 2006
Posts: 12
Thanks: 0
Thanked 0 Times in 0 Posts
Default

oh ok, I understand now. I will be using similar Outlook code because also need to send pdf files through Outlook but I already knew how to do that.

By the way, I tried out your pdf code and it worked with pdf writer and pdf995 but it brings up the Save As dialog box because I haven't set the default path yet.

thanks again,
Donrafeal

 
Old February 25th, 2007, 11:30 PM
Authorized User
 
Join Date: Jul 2004
Posts: 30
Thanks: 0
Thanked 0 Times in 0 Posts
Default

When you set the default path, I think there is a property (check box) in adobe that ask you wether you want a prompt or not. Just uncheck that property and you should be ready to go.






Similar Threads
Thread Thread Starter Forum Replies Last Post
Print PDF from Form seananderson Access VBA 2 February 20th, 2007 10:11 AM
Print to PDF - Can This Be Done? gwenharrison Access VBA 5 January 11th, 2007 05:02 AM
Access report print each page to separate PDF file conh2so4aq Access VBA 5 July 3rd, 2006 08:00 PM
Access to print PDF file to default printer Dkline Access VBA 0 July 7th, 2004 03:24 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.