B
BlueWolverine
Hello,
MS ACCESS 2003 on XP PRO.
A while ago, I found out about lebans.com and the marvelous code there to
print a report to PDF. using VBA. I have found that code to be reliable and
generally awesome. It is with that code that I am having trouble today
however.
Here's the deal. I am using ConvertToPDF in a loop, two loops actually, in
different places.
First place, it works PERFECTLY. I even found some code to automatically
combine the output file with some other stored pdfs and create my end
document automatically. That makes me happy.
Second place, it should be doing the exact same thing except that I am
looping through different options.
***ERROR THAT OCCURS***
In the second place, when I execute the ConvertToPDF function, instead of
outputing the file as expected, where I would hope to see a file whose name
is like "Duty Cycle - Monday: CAR [2009-11Nov-02] [13_15].pdf" I get a file
whose name is "Duty Cycle - Monday -" NOte the lack of extension. It
displays with the broken file icon. I can't open it, and on bad days like
today, I can't delete it later.
I promise I have gone line by line and checked that all these variables are
perfect by the time it gets to the CONVERTtoPDF function call. But please
suggest anything and everything. It's driving me nuts and I can't find where
it is dying. I have included all the code for the broken one. If you need
the successful code, please ask and I will post.
'********************************
'BEGIN CODE
'********************************
Private Sub cmd_Sep_Cars_Click()
Dim frm As Form, ctl() As Control, ctl2() As Control, rpt As Report,
rpt_not As Report, lng_Count_of_car_types As Long
lng_Count_of_car_types = 5
ReDim ctl(1 To lng_Count_of_car_types) As Control
ReDim ctl2(1 To lng_Count_of_car_types) As Control
Dim var_Item As Variant, str_formName As String
Dim str_SQL As String, str_SQL1 As String, str_SQL2 As String, str_SQL3
As String, str_phrase As String, str_phrase1 As String
Dim a_Test As String, a_cars() As Boolean, lcv As Long
Dim str_filename As String, SaveAsDialogYesNo As Boolean, str_pathName
As String
Dim blRet As Boolean, str_TodaysDate As String, l_counter As Long
Dim myDB As Database, tqn As String, rs As Recordset, flag As Boolean
Dim str_TodaysDate_COMPLETE As String, str_filename_COMPLETE As String,
str_filename_PARTIAL As String
Set myDB = CurrentDb
tqn = "q_Day_Specific"
Set rs = myDB.OpenRecordset(tqn)
flag = False
While Not rs.EOF
If rs.Fields(0).Value = Forms!SingleDocument!Route.Value Then
flag = True
End If
rs.MoveNext
Wend
str_TodaysDate = CStr("[" & Format(Now, "YYYY") & "-" & Format(Now,
"MM") & Format(Now, "MMM") & "-" & Format(Now, "DD") & "]" & " " & "[" &
Format(Now, "HH") & "_" & Format(Now, "NN") & "]")
str_TodaysDate_COMPLETE = CStr("[" & Format(Now, "YYYY") & "-" &
Format(Now, "MM") & Format(Now, "MMM") & "-" & Format(Now, "DD") & "]" & " "
& "[" & Format(Now, "HH") & "_" & Format(Now, "NN") & "]")
str_pathName = CStr(Application.CurrentProject.path) & "\"
SaveAsDialogYesNo = False
Set frm = Forms!SingleDocument
Set ctl(1) = Forms!SingleDocument!search_Car
Set ctl(2) = Forms!SingleDocument!search_Truck
Set ctl(3) = Forms!SingleDocument!Search_CUV
Set ctl(4) = Forms!SingleDocument!Search_SUV
Set ctl(5) = Forms!SingleDocument!search_Commercial
Set ctl2(1) = Forms!MainMenu!g_Car
Set ctl2(2) = Forms!MainMenu!g_Truck
Set ctl2(3) = Forms!MainMenu!g_CUV
Set ctl2(4) = Forms!MainMenu!g_SUV
Set ctl2(5) = Forms!MainMenu!g_ComVeh
ctl2(1).Value = ctl(1).Value
ctl2(2).Value = ctl(2).Value
ctl2(3).Value = ctl(3).Value
ctl2(4).Value = ctl(4).Value
ctl2(5).Value = ctl(5).Value
'Pick up number of types
'store tests
lcv = 1
l_counter = 0
While lcv <= lng_Count_of_car_types
If ctl(lcv).Value = True Then
l_counter = l_counter + 1
End If
lcv = lcv + 1
Wend
'if no checkboxes are selected then why is the user using this button.
KILL
If l_counter = 0 Then
MsgBox "Use the regular checklist button!", vbCritical, "Why are you
here?"
Exit Sub
End If
ReDim a_cars(1 To lng_Count_of_car_types) As Boolean
'load values into an array
lcv = 1
While lcv <= lng_Count_of_car_types
a_cars(lcv) = ctl(lcv).Value
lcv = lcv + 1
Wend
var_Item = 1
While var_Item <= UBound(a_cars, 1)
If a_cars(var_Item) <> True Then
'do nothing
Else
lcv = 1
While lcv <= lng_Count_of_car_types
ctl(lcv).Value = False
ctl2(lcv).Value = False
lcv = lcv + 1
Wend
ctl(var_Item).Value = a_cars(var_Item)
ctl2(var_Item).Value = a_cars(var_Item)
'For each test specified, print the document
'if the document requires days of the week, then print one doc for
each day of the week
If flag = True Then
'Use r_SingleChecklist, else use r_SingleChecklistSD
If IsNull(m_Car_Types) Or m_Car_Types = "" Then
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Complete.pdf"
Else
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Complete.pdf"
End If
'DoCmd.OpenReport "r_SingleChecklist", acViewPreview
' Please note the last param signals whether to perform
' font embedding or not. I have turned font embedding ON
for this example.
'vbnullstring
blRet = ConvertReportToPDF("r_SingleChecklist", , _
str_pathName & str_filename,
SaveAsDialogYesNo, False, 150, "", "", 0, 0, 0)
'Call ConvertReportToPDF("r_SingleChecklist", "",
str_filename, SaveAsDialogYesNo, True, 0, "", "", 0, 0, 0)
'NEW 11/5/2009 - COMBINE WITH Stored SURVEY PDF
'DoCmd.Close acDefault, "r_Single_Checklist", acSaveNo
If m_Needs_ExemptLabel(Forms!SingleDocument!Route) = True Then
'combine with the Exemption Label Document
If m_Needs_Survey(Forms!SingleDocument!Route) = True Then
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_PARTIAL)
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename_PARTIAL, str_filename_COMPLETE)
Else
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_COMPLETE)
End If
Else
'do nothing
If m_Needs_Survey(Forms!SingleDocument!Route) = True Then
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename, str_filename_COMPLETE)
Else
'do nothing
End If
End If
Else
If IsNull(m_Car_Types) Or m_Car_Types = "" Then
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Complete.pdf"
Else
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Complete.pdf"
End If
If Forms!SingleDocument!box_Use_Codes = True Then
str_formName = "r_SingCheck_Codes"
Else
str_formName = "r_SingleChecklistSD"
End If
' Please note the last param signals whether to perform
' font embedding or not. I have turned font embedding ON
for this example.
' vbnullstring
blRet = ConvertReportToPDF(str_formName, , _
str_pathName & str_filename,
SaveAsDialogYesNo, False, 150, "", "", 0, 0, 0)
'Call ConvertReportToPDF("r_SingleChecklistSD", "",
str_filename, SaveAsDialogYesNo, True, 0, "", "", 0, 0, 0)
'NEW 11/5/2009 - COMBINE WITH Stored SURVEY PDF
If m_Needs_ExemptLabel(Forms!SingleDocument!Route.Value) =
True Then
'combine with the Exemption Label Document
If m_Needs_Survey(Forms!SingleDocument!Route.Value) =
True Then
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_PARTIAL)
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename_PARTIAL, str_filename_COMPLETE)
Else
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_COMPLETE)
End If
Else
'do nothing
If m_Needs_Survey(Forms!SingleDocument!Route.value) =
True Then
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename, str_filename_COMPLETE)
Else
'do nothing
End If
End If
End If
End If
var_Item = var_Item + 1
Wend
lcv = 1
While lcv <= lng_Count_of_car_types
ctl(lcv).Value = a_cars(lcv)
ctl2(lcv).Value = a_cars(lcv)
lcv = lcv + 1
Wend
Me.Refresh
End Sub
'**************************
'END CODE
'**************************
MS ACCESS 2003 on XP PRO.
A while ago, I found out about lebans.com and the marvelous code there to
print a report to PDF. using VBA. I have found that code to be reliable and
generally awesome. It is with that code that I am having trouble today
however.
Here's the deal. I am using ConvertToPDF in a loop, two loops actually, in
different places.
First place, it works PERFECTLY. I even found some code to automatically
combine the output file with some other stored pdfs and create my end
document automatically. That makes me happy.
Second place, it should be doing the exact same thing except that I am
looping through different options.
***ERROR THAT OCCURS***
In the second place, when I execute the ConvertToPDF function, instead of
outputing the file as expected, where I would hope to see a file whose name
is like "Duty Cycle - Monday: CAR [2009-11Nov-02] [13_15].pdf" I get a file
whose name is "Duty Cycle - Monday -" NOte the lack of extension. It
displays with the broken file icon. I can't open it, and on bad days like
today, I can't delete it later.
I promise I have gone line by line and checked that all these variables are
perfect by the time it gets to the CONVERTtoPDF function call. But please
suggest anything and everything. It's driving me nuts and I can't find where
it is dying. I have included all the code for the broken one. If you need
the successful code, please ask and I will post.
'********************************
'BEGIN CODE
'********************************
Private Sub cmd_Sep_Cars_Click()
Dim frm As Form, ctl() As Control, ctl2() As Control, rpt As Report,
rpt_not As Report, lng_Count_of_car_types As Long
lng_Count_of_car_types = 5
ReDim ctl(1 To lng_Count_of_car_types) As Control
ReDim ctl2(1 To lng_Count_of_car_types) As Control
Dim var_Item As Variant, str_formName As String
Dim str_SQL As String, str_SQL1 As String, str_SQL2 As String, str_SQL3
As String, str_phrase As String, str_phrase1 As String
Dim a_Test As String, a_cars() As Boolean, lcv As Long
Dim str_filename As String, SaveAsDialogYesNo As Boolean, str_pathName
As String
Dim blRet As Boolean, str_TodaysDate As String, l_counter As Long
Dim myDB As Database, tqn As String, rs As Recordset, flag As Boolean
Dim str_TodaysDate_COMPLETE As String, str_filename_COMPLETE As String,
str_filename_PARTIAL As String
Set myDB = CurrentDb
tqn = "q_Day_Specific"
Set rs = myDB.OpenRecordset(tqn)
flag = False
While Not rs.EOF
If rs.Fields(0).Value = Forms!SingleDocument!Route.Value Then
flag = True
End If
rs.MoveNext
Wend
str_TodaysDate = CStr("[" & Format(Now, "YYYY") & "-" & Format(Now,
"MM") & Format(Now, "MMM") & "-" & Format(Now, "DD") & "]" & " " & "[" &
Format(Now, "HH") & "_" & Format(Now, "NN") & "]")
str_TodaysDate_COMPLETE = CStr("[" & Format(Now, "YYYY") & "-" &
Format(Now, "MM") & Format(Now, "MMM") & "-" & Format(Now, "DD") & "]" & " "
& "[" & Format(Now, "HH") & "_" & Format(Now, "NN") & "]")
str_pathName = CStr(Application.CurrentProject.path) & "\"
SaveAsDialogYesNo = False
Set frm = Forms!SingleDocument
Set ctl(1) = Forms!SingleDocument!search_Car
Set ctl(2) = Forms!SingleDocument!search_Truck
Set ctl(3) = Forms!SingleDocument!Search_CUV
Set ctl(4) = Forms!SingleDocument!Search_SUV
Set ctl(5) = Forms!SingleDocument!search_Commercial
Set ctl2(1) = Forms!MainMenu!g_Car
Set ctl2(2) = Forms!MainMenu!g_Truck
Set ctl2(3) = Forms!MainMenu!g_CUV
Set ctl2(4) = Forms!MainMenu!g_SUV
Set ctl2(5) = Forms!MainMenu!g_ComVeh
ctl2(1).Value = ctl(1).Value
ctl2(2).Value = ctl(2).Value
ctl2(3).Value = ctl(3).Value
ctl2(4).Value = ctl(4).Value
ctl2(5).Value = ctl(5).Value
'Pick up number of types
'store tests
lcv = 1
l_counter = 0
While lcv <= lng_Count_of_car_types
If ctl(lcv).Value = True Then
l_counter = l_counter + 1
End If
lcv = lcv + 1
Wend
'if no checkboxes are selected then why is the user using this button.
KILL
If l_counter = 0 Then
MsgBox "Use the regular checklist button!", vbCritical, "Why are you
here?"
Exit Sub
End If
ReDim a_cars(1 To lng_Count_of_car_types) As Boolean
'load values into an array
lcv = 1
While lcv <= lng_Count_of_car_types
a_cars(lcv) = ctl(lcv).Value
lcv = lcv + 1
Wend
var_Item = 1
While var_Item <= UBound(a_cars, 1)
If a_cars(var_Item) <> True Then
'do nothing
Else
lcv = 1
While lcv <= lng_Count_of_car_types
ctl(lcv).Value = False
ctl2(lcv).Value = False
lcv = lcv + 1
Wend
ctl(var_Item).Value = a_cars(var_Item)
ctl2(var_Item).Value = a_cars(var_Item)
'For each test specified, print the document
'if the document requires days of the week, then print one doc for
each day of the week
If flag = True Then
'Use r_SingleChecklist, else use r_SingleChecklistSD
If IsNull(m_Car_Types) Or m_Car_Types = "" Then
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Complete.pdf"
Else
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Complete.pdf"
End If
'DoCmd.OpenReport "r_SingleChecklist", acViewPreview
' Please note the last param signals whether to perform
' font embedding or not. I have turned font embedding ON
for this example.
'vbnullstring
blRet = ConvertReportToPDF("r_SingleChecklist", , _
str_pathName & str_filename,
SaveAsDialogYesNo, False, 150, "", "", 0, 0, 0)
'Call ConvertReportToPDF("r_SingleChecklist", "",
str_filename, SaveAsDialogYesNo, True, 0, "", "", 0, 0, 0)
'NEW 11/5/2009 - COMBINE WITH Stored SURVEY PDF
'DoCmd.Close acDefault, "r_Single_Checklist", acSaveNo
If m_Needs_ExemptLabel(Forms!SingleDocument!Route) = True Then
'combine with the Exemption Label Document
If m_Needs_Survey(Forms!SingleDocument!Route) = True Then
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_PARTIAL)
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename_PARTIAL, str_filename_COMPLETE)
Else
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_COMPLETE)
End If
Else
'do nothing
If m_Needs_Survey(Forms!SingleDocument!Route) = True Then
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename, str_filename_COMPLETE)
Else
'do nothing
End If
End If
Else
If IsNull(m_Car_Types) Or m_Car_Types = "" Then
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & " - " & str_TodaysDate_COMPLETE
& " Complete.pdf"
Else
str_filename = Forms!SingleDocument!Route & " - " &
Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate & ".pdf"
str_filename_PARTIAL = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Partial.pdf"
str_filename_COMPLETE = Forms!SingleDocument!Route &
" - " & Forms!SingleDocument!one_DayofWeek & ": " & m_Car_Types & " - " &
str_TodaysDate_COMPLETE & " Complete.pdf"
End If
If Forms!SingleDocument!box_Use_Codes = True Then
str_formName = "r_SingCheck_Codes"
Else
str_formName = "r_SingleChecklistSD"
End If
' Please note the last param signals whether to perform
' font embedding or not. I have turned font embedding ON
for this example.
' vbnullstring
blRet = ConvertReportToPDF(str_formName, , _
str_pathName & str_filename,
SaveAsDialogYesNo, False, 150, "", "", 0, 0, 0)
'Call ConvertReportToPDF("r_SingleChecklistSD", "",
str_filename, SaveAsDialogYesNo, True, 0, "", "", 0, 0, 0)
'NEW 11/5/2009 - COMBINE WITH Stored SURVEY PDF
If m_Needs_ExemptLabel(Forms!SingleDocument!Route.Value) =
True Then
'combine with the Exemption Label Document
If m_Needs_Survey(Forms!SingleDocument!Route.Value) =
True Then
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_PARTIAL)
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename_PARTIAL, str_filename_COMPLETE)
Else
Call m_Combine_2_PDF(str_filename,
str_ExemptLabel_FileName, str_filename_COMPLETE)
End If
Else
'do nothing
If m_Needs_Survey(Forms!SingleDocument!Route.value) =
True Then
'combine with the survey document
Call m_Combine_2_PDF(str_Survey_FileName,
str_filename, str_filename_COMPLETE)
Else
'do nothing
End If
End If
End If
End If
var_Item = var_Item + 1
Wend
lcv = 1
While lcv <= lng_Count_of_car_types
ctl(lcv).Value = a_cars(lcv)
ctl2(lcv).Value = a_cars(lcv)
lcv = lcv + 1
Wend
Me.Refresh
End Sub
'**************************
'END CODE
'**************************