Guest_imported
New member
- Jan 1, 1970
- 0
I found an example on an internet site and copied the code in the hopes of fixing a problem that I'm having...here's the code that I cut:
Dim n as Long
' Open recordset up here
n = 0
While Not rs.EOF
n = n + 1
FDFSetValue "policy" & n, rs("Policy"
, False
rs.MoveNext
Wend
rs.Close
I want to insert it into my module which looks like this (see below) but don't know where to put it in? Any ideas?
Option Compare Database
Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal
hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal
lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As
Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Function CreateAIGApp()
ShowApp ("AIG"
End Function
Function ShowApp(strCompany As String)
On Error GoTo ErrChk
Dim hDC1 As Long 'Window handle variable.
Dim lVal As Long
Dim FdfAcX As FDFACXLib.FdfApp
Dim Fdf_Output As FDFACXLib.FdfDoc 'Output FDF
Dim rstClient As Recordset
Dim strField As String
Dim varFieldvalue As Variant
Dim strPdfFile As String 'Path + name of PDF form file to be populated
Dim strFdfFile As String 'Path + name of FDF file to create
Dim n As Integer
strPdfFile = "p:\tpg\forms\" & strCompany & "App test.pdf" 'Existing PDF
form file
strFdfFile = "p:\tpg\forms\" & strCompany & "App test.fdf" 'FDF file to
create
Set rstClient = CurrentDb.OpenRecordset("CurrentClientApplicationData"
'Create FDF object
Set FdfAcX = CreateObject("fdfapp.Fdfapp"
'Create FDF output file
Set Fdf_Output = FdfAcX.FDFCreate
'Set return field values and flags
With Fdf_Output
For n = 3 To rstClient.Fields.Count - 1
strField = rstClient.Fields.Name
Select Case rstClient.Fields.Type
Case dbText
varFieldvalue = Nz(rstClient.Fields, " "
Case dbLong
varFieldvalue = Format(Nz(rstClient.Fields, 0), "#,###"
Case dbSingle
varFieldvalue = Format(Nz(rstClient.Fields, 0),
"#,###.##"
Case Else
varFieldvalue = Nz(rstClient.Fields, 0)
End Select
' If strField = "AgentNotes" Then Stop
.FDFSetValue strField, FormatField(strField, varFieldvalue,
strCompany), False
Next n
.FDFSetFile strPdfFile 'Associate FDF file with PDF file"
.FDFSaveToFile strFdfFile 'Create the FDF file on disk
.FDFClose 'Close Output file
End With
rstClient.Close
'Launch Acrobat viewer (Reader or Exchange) with the FDF file.
hDC1 = GetDesktopWindow() 'Get a window handle for ShellExecute's
purposes.
'Some folks pass null in place of hDC1, but this is how an MS example did
it.
lVal = ShellExecute(hDC1, "Open", strFdfFile, "", "Path", 1)
Exit Function
ErrChk:
If Err.Number = 3265 Then
MsgBox "Missing field: '" & strField & "'"
Else
MsgBox Err.Description
End If
End Function
Function FormatField(strField As String, varFieldvalue As Variant,
strCompany As String) As String
Dim strFieldValue As String
If strCompany = "Trans" Then
Select Case strField
Case "SIN"
strFieldValue = Format(varFieldvalue, " & & & &
& & & & & & &"
Case "HomePostal", "BusPostal"
strFieldValue = Format(varFieldvalue, " & & & &
& & &"
Case "DOB", "lastused"
strFieldValue = PutSpaceInDate(varFieldvalue)
Case "Age"
strFieldValue = NearestAge(Nz(Forms!frmclients!Dob, 0))
Case "HomePhone", "BusPhone"
strFieldValue = Format(varFieldvalue, "### # # #
# # # #"
Case "BarCode"
strFieldValue = "Barcode: " & varFieldvalue
Case "MrMrs"
Select Case varFieldvalue
Case "Dr"
' .FDFSetValue "OtherTitle", "Dr.", False
Case "Rev"
' .FDFSetValue "OtherTitle", "Rev.", False
Case Else
strFieldValue = varFieldvalue
End Select
Case Else
strFieldValue = varFieldvalue
End Select
Else
Select Case strField
Case "SIN"
strFieldValue = Format(varFieldvalue, " @ @ @ @ @
@ @ @ @ @ @"
Case "HomePostal", "BusPostal"
strFieldValue = Format(varFieldvalue, "@ @ @ @ @ @"
Case "DOB", "lastused"
strFieldValue = Format(varFieldvalue, " dd
mm yy"
Case "Age"
strFieldValue = NearestAge(Nz(Forms!frmclients!Dob, 0))
Case "HomePhone", "BusPhone"
strFieldValue = Format(varFieldvalue, "(###) ### - ####"
Case "MrMrs"
Select Case varFieldvalue
Case "Dr"
' .FDFSetValue "OtherTitle", "Dr.", False
Case "Rev"
' .FDFSetValue "OtherTitle", "Rev.", False
Case Else
strFieldValue = varFieldvalue
End Select
Case Else
strFieldValue = varFieldvalue
End Select
End If
FormatField = strFieldValue
End Function
Function PutSpaceInDate(dtDate As Variant)
Dim strdate As String
Dim intLoop As Integer
Dim strSpaced As String
strdate = Format(dtDate, "ddmmyyyy"
For intLoop = 1 To Len(strdate)
If Len(strSpaced) > 0 Then
strSpaced = strSpaced & " " & Mid(strdate, intLoop, 1)
Else
strSpaced = Mid(strdate, intLoop, 1)
End If
Next intLoop
PutSpaceInDate = strSpaced
End Function
Function Demo()
Dim strCompany As String
strCompany = "Trans"
Dim FdfAcX As FDFACXLib.FdfApp
Dim Fdf_Output As FDFACXLib.FdfDoc 'Output FDF
Dim dBase1 As Database
Dim sDB_File As String
Dim sSQL As String
Dim rstClient As Recordset
Dim nIndex As Integer
Dim rstFields As Recordset
Dim strField As String
Dim strFieldValue As String
Dim strPdfFile As String 'Path + name of PDF form file to be populated
Dim strFdfFile As String 'Path + name of FDF file to create
strPdfFile = "n:\users\Ryan\" & strCompany & "App.pdf" 'Existing PDF form
file
strFdfFile = "n:\users\Ryan\" & strCompany & "App.fdf" 'FDF file to
create
Set rstClient = CurrentDb.OpenRecordset("client"
Set rstFields = CurrentDb.OpenRecordset("SELECT * FROM Fieldnames WHERE " &
strCompany & "=-1"
'Get field values from record
'Create FDF object
Set FdfAcX = CreateObject("fdfapp.Fdfapp"
'Create FDF output file
Set Fdf_Output = FdfAcX.FDFCreate
'Set return field values and flags
With Fdf_Output
Do Until rstFields.EOF
strField = rstFields!FieldName
Select Case strField
Case "SIN"
strFieldValue = Format(Nz(rstClient!SIN, " ", "# # #
# # # # # #"
Case "HomePostal"
strFieldValue = Format(Nz(rstClient!HomePostal, " ", " # #
# # # # "
Case "Income", "NetWorth"
strFieldValue = Format(Nz(rstClient.Fields(strField),
0), "$#,###"
Case "Age"
If strCompany = "Trans" Then
strFieldValue = NearestAge(Nz(rstClient!Dob, 0))
Else
strFieldValue = ActualAge(Nz(rstClient!Dob, 0))
End If
Case "HomePhone"
strFieldValue = Format(Nz(rstClient!HomePhone, " ", "###
# # # # # # #"
Case "BusPhone"
strFieldValue = Format(Nz(rstClient!BusPhone, " ", "###
# # # # # # #"
Case Else
strFieldValue = Nz(rstClient.Fields(strField))
End Select
Select Case strField
Case "Sex"
If strFieldValue = "M" Then
.FDFSetValue "Male", "X", False
.FDFSetValue "Female", " ", False
Else
.FDFSetValue "Female", "X", False
.FDFSetValue "Male", " ", False
End If
Case "Smoker"
Select Case strFieldValue
Case "N"
.FDFSetValue "NonSmoker", "X", False
.FDFSetValue "Smoker", " ", False
Case Else
.FDFSetValue "NonSmoker", " ", False
.FDFSetValue "Smoker", "X", False
End Select
Case Else
.FDFSetValue strField, strFieldValue, False
End Select
rstFields.MoveNext
Loop
.FDFSetFile strPdfFile 'Associate FDF file with PDF file"
.FDFSaveToFile strFdfFile 'Create the FDF file on disk
.FDFClose 'Close Output file
End With
'Launch Acrobat viewer (Reader or Exchange) with the FDF file.
Dim hDC1 As Long 'Window handle variable.
hDC1 = GetDesktopWindow() 'Get a window handle for ShellExecute's
purposes.
'You can replace "Open" with "Print" to print the PDF.
'Some folks pass null in place of hDC1, but this is how an MS example did
it.
Dim lVal As Long
lVal = ShellExecute(hDC1, "Open", strFdfFile, "", "Path", 1)
End Function
Dim n as Long
' Open recordset up here
n = 0
While Not rs.EOF
n = n + 1
FDFSetValue "policy" & n, rs("Policy"
, Falsers.MoveNext
Wend
rs.Close
I want to insert it into my module which looks like this (see below) but don't know where to put it in? Any ideas?
Option Compare Database
Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal
hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal
lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As
Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Function CreateAIGApp()
ShowApp ("AIG"
End Function
Function ShowApp(strCompany As String)
On Error GoTo ErrChk
Dim hDC1 As Long 'Window handle variable.
Dim lVal As Long
Dim FdfAcX As FDFACXLib.FdfApp
Dim Fdf_Output As FDFACXLib.FdfDoc 'Output FDF
Dim rstClient As Recordset
Dim strField As String
Dim varFieldvalue As Variant
Dim strPdfFile As String 'Path + name of PDF form file to be populated
Dim strFdfFile As String 'Path + name of FDF file to create
Dim n As Integer
strPdfFile = "p:\tpg\forms\" & strCompany & "App test.pdf" 'Existing PDF
form file
strFdfFile = "p:\tpg\forms\" & strCompany & "App test.fdf" 'FDF file to
create
Set rstClient = CurrentDb.OpenRecordset("CurrentClientApplicationData"
'Create FDF object
Set FdfAcX = CreateObject("fdfapp.Fdfapp"
'Create FDF output file
Set Fdf_Output = FdfAcX.FDFCreate
'Set return field values and flags
With Fdf_Output
For n = 3 To rstClient.Fields.Count - 1
strField = rstClient.Fields
.NameSelect Case rstClient.Fields
.TypeCase dbText
varFieldvalue = Nz(rstClient.Fields
, " "Case dbLong
varFieldvalue = Format(Nz(rstClient.Fields
, 0), "#,###"Case dbSingle
varFieldvalue = Format(Nz(rstClient.Fields
, 0),"#,###.##"
Case Else
varFieldvalue = Nz(rstClient.Fields
, 0)End Select
' If strField = "AgentNotes" Then Stop
.FDFSetValue strField, FormatField(strField, varFieldvalue,
strCompany), False
Next n
.FDFSetFile strPdfFile 'Associate FDF file with PDF file"
.FDFSaveToFile strFdfFile 'Create the FDF file on disk
.FDFClose 'Close Output file
End With
rstClient.Close
'Launch Acrobat viewer (Reader or Exchange) with the FDF file.
hDC1 = GetDesktopWindow() 'Get a window handle for ShellExecute's
purposes.
'Some folks pass null in place of hDC1, but this is how an MS example did
it.
lVal = ShellExecute(hDC1, "Open", strFdfFile, "", "Path", 1)
Exit Function
ErrChk:
If Err.Number = 3265 Then
MsgBox "Missing field: '" & strField & "'"
Else
MsgBox Err.Description
End If
End Function
Function FormatField(strField As String, varFieldvalue As Variant,
strCompany As String) As String
Dim strFieldValue As String
If strCompany = "Trans" Then
Select Case strField
Case "SIN"
strFieldValue = Format(varFieldvalue, " & & & &
& & & & & & &"
Case "HomePostal", "BusPostal"
strFieldValue = Format(varFieldvalue, " & & & &
& & &"
Case "DOB", "lastused"
strFieldValue = PutSpaceInDate(varFieldvalue)
Case "Age"
strFieldValue = NearestAge(Nz(Forms!frmclients!Dob, 0))
Case "HomePhone", "BusPhone"
strFieldValue = Format(varFieldvalue, "### # # #
# # # #"
Case "BarCode"
strFieldValue = "Barcode: " & varFieldvalue
Case "MrMrs"
Select Case varFieldvalue
Case "Dr"
' .FDFSetValue "OtherTitle", "Dr.", False
Case "Rev"
' .FDFSetValue "OtherTitle", "Rev.", False
Case Else
strFieldValue = varFieldvalue
End Select
Case Else
strFieldValue = varFieldvalue
End Select
Else
Select Case strField
Case "SIN"
strFieldValue = Format(varFieldvalue, " @ @ @ @ @
@ @ @ @ @ @"
Case "HomePostal", "BusPostal"
strFieldValue = Format(varFieldvalue, "@ @ @ @ @ @"
Case "DOB", "lastused"
strFieldValue = Format(varFieldvalue, " dd
mm yy"
Case "Age"
strFieldValue = NearestAge(Nz(Forms!frmclients!Dob, 0))
Case "HomePhone", "BusPhone"
strFieldValue = Format(varFieldvalue, "(###) ### - ####"
Case "MrMrs"
Select Case varFieldvalue
Case "Dr"
' .FDFSetValue "OtherTitle", "Dr.", False
Case "Rev"
' .FDFSetValue "OtherTitle", "Rev.", False
Case Else
strFieldValue = varFieldvalue
End Select
Case Else
strFieldValue = varFieldvalue
End Select
End If
FormatField = strFieldValue
End Function
Function PutSpaceInDate(dtDate As Variant)
Dim strdate As String
Dim intLoop As Integer
Dim strSpaced As String
strdate = Format(dtDate, "ddmmyyyy"
For intLoop = 1 To Len(strdate)
If Len(strSpaced) > 0 Then
strSpaced = strSpaced & " " & Mid(strdate, intLoop, 1)
Else
strSpaced = Mid(strdate, intLoop, 1)
End If
Next intLoop
PutSpaceInDate = strSpaced
End Function
Function Demo()
Dim strCompany As String
strCompany = "Trans"
Dim FdfAcX As FDFACXLib.FdfApp
Dim Fdf_Output As FDFACXLib.FdfDoc 'Output FDF
Dim dBase1 As Database
Dim sDB_File As String
Dim sSQL As String
Dim rstClient As Recordset
Dim nIndex As Integer
Dim rstFields As Recordset
Dim strField As String
Dim strFieldValue As String
Dim strPdfFile As String 'Path + name of PDF form file to be populated
Dim strFdfFile As String 'Path + name of FDF file to create
strPdfFile = "n:\users\Ryan\" & strCompany & "App.pdf" 'Existing PDF form
file
strFdfFile = "n:\users\Ryan\" & strCompany & "App.fdf" 'FDF file to
create
Set rstClient = CurrentDb.OpenRecordset("client"
Set rstFields = CurrentDb.OpenRecordset("SELECT * FROM Fieldnames WHERE " &
strCompany & "=-1"
'Get field values from record
'Create FDF object
Set FdfAcX = CreateObject("fdfapp.Fdfapp"
'Create FDF output file
Set Fdf_Output = FdfAcX.FDFCreate
'Set return field values and flags
With Fdf_Output
Do Until rstFields.EOF
strField = rstFields!FieldName
Select Case strField
Case "SIN"
strFieldValue = Format(Nz(rstClient!SIN, " "
, "# # ## # # # # #"
Case "HomePostal"
strFieldValue = Format(Nz(rstClient!HomePostal, " "
, " # ## # # # "
Case "Income", "NetWorth"
strFieldValue = Format(Nz(rstClient.Fields(strField),
0), "$#,###"
Case "Age"
If strCompany = "Trans" Then
strFieldValue = NearestAge(Nz(rstClient!Dob, 0))
Else
strFieldValue = ActualAge(Nz(rstClient!Dob, 0))
End If
Case "HomePhone"
strFieldValue = Format(Nz(rstClient!HomePhone, " "
, "#### # # # # # #"
Case "BusPhone"
strFieldValue = Format(Nz(rstClient!BusPhone, " "
, "#### # # # # # #"
Case Else
strFieldValue = Nz(rstClient.Fields(strField))
End Select
Select Case strField
Case "Sex"
If strFieldValue = "M" Then
.FDFSetValue "Male", "X", False
.FDFSetValue "Female", " ", False
Else
.FDFSetValue "Female", "X", False
.FDFSetValue "Male", " ", False
End If
Case "Smoker"
Select Case strFieldValue
Case "N"
.FDFSetValue "NonSmoker", "X", False
.FDFSetValue "Smoker", " ", False
Case Else
.FDFSetValue "NonSmoker", " ", False
.FDFSetValue "Smoker", "X", False
End Select
Case Else
.FDFSetValue strField, strFieldValue, False
End Select
rstFields.MoveNext
Loop
.FDFSetFile strPdfFile 'Associate FDF file with PDF file"
.FDFSaveToFile strFdfFile 'Create the FDF file on disk
.FDFClose 'Close Output file
End With
'Launch Acrobat viewer (Reader or Exchange) with the FDF file.
Dim hDC1 As Long 'Window handle variable.
hDC1 = GetDesktopWindow() 'Get a window handle for ShellExecute's
purposes.
'You can replace "Open" with "Print" to print the PDF.
'Some folks pass null in place of hDC1, but this is how an MS example did
it.
Dim lVal As Long
lVal = ShellExecute(hDC1, "Open", strFdfFile, "", "Path", 1)
End Function
