convert to pdf 3

[dodge20]

I have a form called coupons that is based off of a table. It contains 300+ records. Each record has a special code that I want to use for naming. So I want to create a seperate pdf file for each record based on that record's special code. For example:



Record 1 code: AA
File output would be AA.pdf



Record2 code: AB
File output would be AB.pdf



I would like to be able to do this in 1 step, not having to manually do it 300+ times. I don't know VBA, so go easy on me.



Dodge20

 

[PHV]

Public Sub SaveReportAsPDF(strReportName As String, strFilter As String)
TWO parameters expected
SaveReportAsPDF "SettlementReport", "C:\Agentfiles\" & rs!Name1 & ".pdf", "name1='" & rs!Name1 & "'"
THREE parameters

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[kmclane]

Ok, thanks to Oakleaf8 I have this code:
Function fncSaveReports()

Dim qdfTemp As DAO.QueryDef
Dim strSQL As String
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim stDocName As String

stDocName = "Settlementreport"

Set rst = CurrentDb.OpenRecordset("TotalSettleAgent")
Set fld = rst("[name1]")

rst.MoveFirst

Do Until rst.EOF

'create the SQL string to select the record for each report
strSQL = "SELECT* FROM rst WHERE [name1] = '" & fld & "'"

'open the query that runs the report
Set qdfTemp = CurrentDb.QueryDefs("totalsettleagent")

'assign strSQL to the SQL property of the Query.
qdfTemp.SQL = strSQL

'Set qdfTemp to nothing so you don't have open objects
Set qdfTemp = Nothing

'Call the SaveReportAsPDF from the Tek-Tips FAQ function saved in a module
Call SaveReportAsPDF(stDocName, "C:\agentfiles\" & fld & ".pdf")

rst.MoveNext

Loop

End Function

But I am getting a "circular reference" error caused by "totalsettleagent". It seems to me that I shouldn't be opening the query twice, can anyone tell me how to change this?
Ken

- If you are flammable and have legs, you are never blocking a fire exit.
Mitch Hedburg

 

[kmclane]

Well I found out why I was getting that error, the code replaced my query with the value of strSQL. Now I have to retype my 4 page query in. I don't know why I printed the SQL statement yesterday, but boy am I glad I did. While I do that, does anyone know how to make this work?
Ken

- If you are flammable and have legs, you are never blocking a fire exit.
Mitch Hedburg

 

[PHV]

kmclane, just a tip:
Before testing ALWAYS BACKUP

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[kmclane]

Real good idea. I have a printout, but some of my join statement is missing. Joy.
Ken

- If you are flammable and have legs, you are never blocking a fire exit.
Mitch Hedburg

 

[Jay319]

I have been doing the same thing that dodge20 has explained at the beginning of the posts using Acrobat 5. Now with Acrobat 7 this does not appear to work.

Does anyone know how to make this work with Acrobat 7 or is there a way to use this same cod to print to a postscript file?

Thanks, Jay

 

[kmclane]

I found an easier wayu to accomplish this with version 6. Just programatically change the caption of the report, set your pdf printer as the default and to not promt for a filename. So much simpler. Let me know if you need any nore in depth info.
Ken

- If you are flammable and have legs, you are never blocking a fire exit.
Mitch Hedburg

 

[Jay319]

I thought I would post the whole code which we have been using and working with Acrobat 5. Hopefully to clarify what we are trying to do .. either make this work with Acrobat 7 or print to a post script that I can use in Distiller.

The forms are coming from Access DB.

Option Compare Database

   Public Const REG_SZ As Long = 1
   Public Const REG_DWORD As Long = 4

   Public Const HKEY_CLASSES_ROOT = &H80000000
   Public Const HKEY_CURRENT_USER = &H80000001
   Public Const HKEY_LOCAL_MACHINE = &H80000002
   Public Const HKEY_USERS = &H80000003

   Public Const ERROR_NONE = 0
   Public Const ERROR_BADDB = 1
   Public Const ERROR_BADKEY = 2
   Public Const ERROR_CANTOPEN = 3
   Public Const ERROR_CANTREAD = 4
   Public Const ERROR_CANTWRITE = 5
   Public Const ERROR_OUTOFMEMORY = 6
   Public Const ERROR_ARENA_TRASHED = 7
   Public Const ERROR_ACCESS_DENIED = 8
   Public Const ERROR_INVALID_PARAMETERS = 87
   Public Const ERROR_NO_MORE_ITEMS = 259

   Public Const KEY_QUERY_VALUE = &H1
   Public Const KEY_SET_VALUE = &H2
   Public Const KEY_ALL_ACCESS = &H3F

   Public Const REG_OPTION_NON_VOLATILE = 0

   Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
   Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
   "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
   As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
   As Long, phkResult As Long, lpdwDisposition As Long) As Long
   Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
   Long) As Long
   Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As String, lpcbData As Long) As Long
   Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, lpData As _
   Long, lpcbData As Long) As Long
   Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
   String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
   As Long, lpcbData As Long) As Long
   Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
   String, ByVal cbData As Long) As Long
   Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
   ByVal cbData As Long) As Long

Public Sub SaveReportAsPDF(strReportName As String, strPath As String)

    If Dir("C:\defaultprinter.bat") <> "defaultprinter.bat" Then
        Call AddDefaultPrinterBat
        sSleep (5000)

    End If

    Dim strOldDefault As String
    Dim RetVal As Variant
    
    strOldDefault = _
        Left(QueryKey("Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device"), _
        InStr(1, QueryKey("Software\Microsoft\Windows NT\CurrentVersion\Windows", _
        "Device"), ",") - 1)
    
    RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & "Acrobat PDFWriter" & Chr(34), vbMinimizedNoFocus)
    
    'SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", "Acrobat PDFWriter,winspool,LPT1:", REG_SZ
    
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename", strPath, REG_SZ
    
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0, REG_SZ

    sSleep (5000)


    DoCmd.OpenForm strReportName
    
    RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & strOldDefault & Chr(34), vbMinimizedNoFocus)
    
    'SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", strOldDefault, REG_SZ


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

   Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
   String, vValue As Variant) As Long
       Dim cch As Long
       Dim lrc As Long
       Dim lType As Long
       Dim lValue As Long
       Dim sValue As String

       On Error GoTo QueryValueExError

       ' 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

Public Sub AddDefaultPrinterBat()

    Dim hFile As Long
    
    hFile = FreeFile
    
    Open "C:\defaultprinter.bat" For Output Access Write As hFile
    
    Print #hFile, "rundll32 printui.dll,PrintUIEntry /y /n %1"
    
    Close hFile

End Sub
Public Sub SaveFormAsPDF(strFormName As String, strPath As String, strFilter As String)

    If Dir("C:\defaultprinter.bat") <> "defaultprinter.bat" Then
        Call AddDefaultPrinterBat
        
    End If

    Dim strOldDefault As String
    Dim RetVal As Variant
    
    strOldDefault = _
        Left(QueryKey("Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device"), _
        InStr(1, QueryKey("Software\Microsoft\Windows NT\CurrentVersion\Windows", _
        "Device"), ",") - 1)
    
    RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & "Acrobat PDFWriter" & Chr(34), vbMinimizedNoFocus)
    
    'SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", "Acrobat PDFWriter,winspool,LPT1:", REG_SZ
    
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename", strPath, REG_SZ
    
    SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0, REG_SZ

    

    DoCmd.OpenForm strFormName, , , strFilter 'Open Form with Condition
    DoCmd.PrintOut 'Print it
    DoCmd.Close acForm, strFormName 'Close it

    RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & strOldDefault & Chr(34), vbMinimizedNoFocus)
    
    'SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", strOldDefault, REG_SZ

End Sub

Thanks, Jay

 

[kmclane]

I got rid of all this code. I have a recordset that I open that has the filter I use for each report and the filename I want to use. My VB code opens the recordset, moves to the first record, opens the report, changes the caption property to the filename, saves the report, reopens it with the filter, prints it to the default printer(Adobe, which is set to not ask for a filename or display the output), closes the report, move to the next record and loop. This took a day long process where I had to manually name each file and reduced it to about three hours, all done on the fly and without user intervention. At the end I have a directory with all my reports in pdf format. I never could get the above code to work in 6.0, and you may very well find the same for 7. Fortunately the simple method is so much easier to work with.

- If you are flammable and have legs, you are never blocking a fire exit.
Mitch Hedburg