• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 355
  • Last Modified:

Generate PDF file from Access 2000 and Access 2002 Report

I am trying to generate a pdf file from an Access 2000 and/or Access 2002 report.  I would like to be able to create the pdf and save the it to a specific directory all in code.  Please help.
0
jenniferd732
Asked:
jenniferd732
  • 11
  • 6
  • 2
  • +2
1 Solution
 
moraljuCommented:
Edit every report to print to the AdobePDF print driver
then
DoCmd.OpenReport "Report Name1", acViewNormal
0
 
jenniferd732Author Commented:
I need to do it with VBA code because there are about 100 reports.  I modify a query and set the report's recordsource.  Then I run the report using docmd.  Now I need to print to the PDF Distiller (Acrobat 6.0) and save the pdf file all in code.  The problem I am having is how do I print the pdf and save it programatically?
0
 
flavoCommented:
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
jenniferd732Author Commented:
Thanks Dave, but I would like to not have to purchase anything if possible.  I have also tried the other example that link provided, but with no luck.  I have seen what looks like some registry manipulation to store what the PDF file name is to be called, but have no idea on how to do this.  I would really like to create the pdf's and save them all in a directory and setting the name of the pdf during the save process in code, but am having trouble doing that.
0
 
flavoCommented:
Trying to get it working with CutePDF (free) but i need to use sendkeys, and it ant working

code soo far - need to get a pause or something to make sure the file name is put into the pdf file name bit (hate using sendkeys!)  

Need to refrence MS Excel Obj Lib, used excel wait command, didnt work!

I need to do some work, so maybe you / someone else can do better with it..

Sub test()

Dim sFileandPath As String
Dim xlApp As Excel.Application
Dim newHour As Integer
Dim newMinute As Integer
Dim newSecond As Integer
Dim waitTime As Date

sFileandPath = "c:\test.pdf"

Set xlApp = New Excel.Application

DoCmd.OpenReport "rptTest", acViewPreview
DoCmd.PrintOut acPrintAll, 1, 1, acHigh


DoEvents

MsgBox "ready to print?"


newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)

xlApp.Wait waitTime
DoEvents

SendKeys sFileandPath, False
SendKeys "{Enter}", False


End Sub
0
 
jenniferd732Author Commented:
I found this which apparently works, but I don't know how to do the registry part.  Maybe if we can figure that out it might work???
0
 
flavoCommented:
nearly there


Dim sFileandPath As String
Dim xlApp As Excel.Application
Dim newHour As Integer
Dim newMinute As Integer
Dim newSecond As Integer
Dim waitTime As Date

sFileandPath = "c:\test2.pdf"

Set xlApp = New Excel.Application

DoCmd.OpenReport "rptTest", acViewPreview
DoCmd.PrintOut acPrintAll, 1, 1, acHigh


DoEvents




newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)

xlApp.Wait waitTime
DoEvents
AppActivate "Save As", True

SendKeys sFileandPath, True
SendKeys "{Enter}", True
0
 
flavoCommented:
which registery bit???
0
 
jenniferd732Author Commented:
Opps...forgot the link, but maybe we won't need it if you are close...
0
 
jenniferd732Author Commented:
0
 
jenniferd732Author Commented:
If I change the default printer, then run this line of code:

DoCmd.OpenReport "Test"

A prompt comes up that asks me to save the pdf.  This is the part I want to automate from code.  Please Help....
0
 
flavoCommented:
Do you want the file name done automoatically or not??
0
 
jenniferd732Author Commented:
Yes, that would be wonderful!
0
 
jenniferd732Author Commented:
Apparently setting value for PDFFileName in the registry stops file dialog box from appearing.  How do I set this registry value?
0
 
flavoCommented:
ill see... a little busy trying to get a job out the door
0
 
dtomlinCommented:
I do this all the time, but you cant do it in ACCESS alone.  You need some type of PDF converter.   Personally I like to use the AMYUNI print driver.  What it does is acts like a printer on the machine.  Once installed, you can print from any windoze application.    I like to make reports that run via a macro at night (1,000's of page sometimes).  Just set you printer to the PDF converter and VIOLA  you got PDF's on the hard driver (Or network)   If you code you can even design webpages with links to each of the PDF files.  The options are limitless with this converter - if you can print you can make PDF's - PERIOD!  Visit www.amyuni.com  The cost I thing is $85 per license - instal takes about 30 seconds and your "printing" pdfs to disk 30 seconds later.  Cheers!  Dan
0
 
jenniferd732Author Commented:
I have the solution:

Code as follows:

Public Sub CreatePDF()

    Dim db As DAO.Database
    Set db = CurrentDb
   
    Dim rs As DAO.Recordset
    Set rs = db.OpenRecordset("Test")
   
    'TODO: change to PDFWriter printer here
   
    Do While Not rs.EOF
        Call SaveFormAsPDF("Test", "C:\Temp\" & rs!ID & ".pdf", "ID=" & rs!ID & "")
        rs.MoveNext
    Loop
   
    rs.Close
    Set db = Nothing
    'TODO: change back to default printer here
   
End Sub

Public Sub SaveFormAsPDF(strReportName As String, strPath As String, strFilter As String)

    Dim RetVal As Variant
   
    'set registry values
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename", strPath, REG_SZ
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0, REG_SZ
   
    'open report with filter
    DoCmd.OpenReport strReportName, acViewPreview, , strFilter
    DoCmd.PrintOut
    DoCmd.Close acReport, strReportName

End Sub

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
    lType As Long, vValue As Variant) As Long
   
    Dim lValue As Long
    Dim sValue As String
   
    Select Case lType
        Case REG_SZ
            sValue = vValue & Chr$(0)
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
            lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
            lType, lValue, 4)
    End Select
   
End Function

Public Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
    String, vValue As Variant) As Long
   
On Error GoTo QueryValueExError

    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
   
    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5
   
    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)
           
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
            sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
            lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select
   
QueryValueExExit:
    QueryValueEx = lrc
    Exit Function
   
QueryValueExError:
    Resume QueryValueExExit
   
End Function

Public Function CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)

    Dim hNewKey As Long ' Handle to the new key
    Dim lRetVal As Long ' Result of the RegCreateKeyEx function

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
        KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)

    RegCloseKey (hNewKey)

End Function

Public Function SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

    Dim lRetVal As Long ' Result of the SetValueEx function
    Dim hKey As Long ' Handle of open key

    ' Open the specified key
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, KEY_SET_VALUE, hKey)

    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

    RegCloseKey (hKey)

End Function

Public Function QueryKey(sKeyName As String, sValueName As String)

    Dim lRetVal As Long ' Result of the API functions
    Dim hKey As Long ' Handle of opened key
    Dim vValue As Variant ' Setting of queried value
   
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, KEY_QUERY_VALUE, hKey)
   
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
   
    QueryKey = vValue
   
    RegCloseKey (hKey)

End Function


I found the basis for this code at:
http://www.tek-tips.com/gfaqs.cfm/lev2/4/lev3/27/pid/705/fid/1635
AND
http://www.tek-tips.com/gviewthread.cfm/pid/705/qid/816439
0
 
jenniferd732Author Commented:
Thanks to everyone for their input and effort, but I solved the problem on my own.

Thanks,
Jennifer
0
 
dtomlinCommented:
So what dd you do?  Expert's Exchange please!
0
 
jenniferd732Author Commented:
The solution is in the comment that I added on 04/29/2004 11:10PM CDT.  
0
 
seanmrmdCommented:
Will this work with Acrobat 6.0?
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 11
  • 6
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now