jenniferd732
asked on
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.
ASKER
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?
see this link
https://www.experts-exchange.com/questions/20646200/Saving-to-pdf.html
Good Luck
Dave!
https://www.experts-exchange.com/questions/20646200/Saving-to-pdf.html
Good Luck
Dave!
ASKER
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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???
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
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
which registery bit???
ASKER
Opps...forgot the link, but maybe we won't need it if you are close...
ASKER
It has been a very long day...
Link:
https://www.experts-exchange.com/questions/20973045/Generate-PDF-file-from-Access-2000-and-Access-2002-Report.html
Link:
https://www.experts-exchange.com/questions/20973045/Generate-PDF-file-from-Access-2000-and-Access-2002-Report.html
ASKER
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....
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....
Do you want the file name done automoatically or not??
ASKER
Yes, that would be wonderful!
ASKER
Apparently setting value for PDFFileName in the registry stops file dialog box from appearing. How do I set this registry value?
ill see... a little busy trying to get a job out the door
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
ASKER
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(strReportNam e 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(lhKe y, 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(lPredefined Key, 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
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(strReportNam
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,
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKe
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,
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(lPredefined
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_
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_
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
ASKER
Thanks to everyone for their input and effort, but I solved the problem on my own.
Thanks,
Jennifer
Thanks,
Jennifer
So what dd you do? Expert's Exchange please!
ASKER
The solution is in the comment that I added on 04/29/2004 11:10PM CDT.
Will this work with Acrobat 6.0?
then
DoCmd.OpenReport "Report Name1", acViewNormal