kkenney123
02-26-2009, 07:29 AM
Hey there,
Does anyone know of a way to check for the presence of a dialog box? I have a DB that prints reports to pdf and then combines them. The problem that I am having is when I print the reports to the pdf printer, it always asks me to confirm the save as name. I just want it to create them using the report name (default), because I have the program combine them and create a new file that I keep and kill all of the junk files that were created. Basically, I am trying to get the save as dialog box to be automated so the user doesnt have to click save for each report. Right now I am using a send keys command that will automatically save as each dialog pops up. (Just because I know this will come up, I will say now that I have not been able to find a way to set the pdf printer up so that it wont ask for the save name, either through its own settings or VBA) The problem here is that depending on how long the report takes to print, the dialog comes up at different times, and the send keys function is either too early or too late. I would like a loop that checks for the presence of the dialog box, and once it appears to send the sendkeys command.
Here is my code:
Private Sub lblFile_Click()
Dim b As Boolean
Dim vartimer As Variant
Dim PONumber As String
Dim MailResponse As Integer
Dim PDDocA As CAcroPDDoc
Dim PDDocB As CAcroPDDoc
Dim PDDocC As CAcroPDDoc
Dim PDDocD As CAcroPDDoc
PONumber = txtPONumber.Value
Set Application.Printer = Application.Printers("Adobe PDF")
printFlag = True
DoCmd.OpenReport "rptFaxCover", acViewNormal, , , acWindowNormal, txtPONumber
'This is where I would like the loop to check for the dialog box
SendKeys "%" & "(s)"
DoCmd.OpenReport "rptPO", acViewNormal, , , acWindowNormal, txtPONumber
'This is where I would like the loop to check for the dialog box
SendKeys "%" & "(s)"
DoCmd.OpenReport "rptPOTerms", acViewNormal, , , acWindowNormal
'This is where I would like the loop to check for the dialog box
SendKeys "%" & "(s)"
printFlag = False
Set PDDocA = CreateObject("AcroExch.PDDoc")
Set PDDocB = CreateObject("AcroExch.PDDoc")
Set PDDocC = CreateObject("AcroExch.PDDoc")
Set PDDocD = CreateObject("AcroExch.PDDoc")
b = PDDocB.Open("S:\P & D\Projects\PO_Temp\rptPO.pdf")
b = PDDocA.Open("S:\P & D\Projects\PO_Temp\rptPOTerms.pdf")
b = PDDocA.InsertPages(-1, PDDocB, 0, 0, True)
b = PDDocA.Save(1, "S:\P & D\Projects\PO_Temp\PO1.pdf")
Sleep 2000
b = PDDocD.Open("S:\P & D\Projects\PO_Temp\qFaxCover.pdf")
b = PDDocC.Open("S:\P & D\Projects\PO_Temp\PO1.pdf")
b = PDDocC.InsertPages(-1, PDDocD, 0, 0, True)
b = PDDocC.Save(1, "S:\P & D\Projects\PO_Temp\" & (PONumber) & ".pdf")
If Dir("S:\P & D\Projects\PO_Temp\" & (PONumber) & ".pdf") = "" Then
Do While Dir("S:\P & D\Projects\PO_Temp\" & (PONumber) & ".pdf") = ""
Sleep 2000
Loop
End If
b = PDDocA.Close
b = PDDocB.Close
b = PDDocD.Close
MailResponse = MsgBox("Would you like to E-mail this PO?", vbYesNo, "Email PO?")
If MailResponse = vbYes Then
AppActivate ("Inbox - Microsoft Outlook")
Sleep 500
SendKeys "^" & "(n)"
Else
Set Application.Printer = Application.Printers("\\server1\KONICA MINOLTA 350/250/200 PS")
End If
Kill ("S:\P & D\Projects\PO_Temp\qFaxCover.pdf")
Kill ("S:\P & D\Projects\PO_Temp\rptPO.pdf")
Kill ("S:\P & D\Projects\PO_Temp\rptPOTerms.pdf")
Kill ("S:\P & D\Projects\PO_Temp\PO1.pdf")
Set Application.Printer = Application.Printers("\\server1\KONICA MINOLTA 350/250/200 PS")
End Sub
I hope this is all easy enough to read. I know there are probably some pieces in there that totally violate best practices, but they work. All except for that send keys command.
Thanks in advance for any help you guys can give.
-Krys
Does anyone know of a way to check for the presence of a dialog box? I have a DB that prints reports to pdf and then combines them. The problem that I am having is when I print the reports to the pdf printer, it always asks me to confirm the save as name. I just want it to create them using the report name (default), because I have the program combine them and create a new file that I keep and kill all of the junk files that were created. Basically, I am trying to get the save as dialog box to be automated so the user doesnt have to click save for each report. Right now I am using a send keys command that will automatically save as each dialog pops up. (Just because I know this will come up, I will say now that I have not been able to find a way to set the pdf printer up so that it wont ask for the save name, either through its own settings or VBA) The problem here is that depending on how long the report takes to print, the dialog comes up at different times, and the send keys function is either too early or too late. I would like a loop that checks for the presence of the dialog box, and once it appears to send the sendkeys command.
Here is my code:
Private Sub lblFile_Click()
Dim b As Boolean
Dim vartimer As Variant
Dim PONumber As String
Dim MailResponse As Integer
Dim PDDocA As CAcroPDDoc
Dim PDDocB As CAcroPDDoc
Dim PDDocC As CAcroPDDoc
Dim PDDocD As CAcroPDDoc
PONumber = txtPONumber.Value
Set Application.Printer = Application.Printers("Adobe PDF")
printFlag = True
DoCmd.OpenReport "rptFaxCover", acViewNormal, , , acWindowNormal, txtPONumber
'This is where I would like the loop to check for the dialog box
SendKeys "%" & "(s)"
DoCmd.OpenReport "rptPO", acViewNormal, , , acWindowNormal, txtPONumber
'This is where I would like the loop to check for the dialog box
SendKeys "%" & "(s)"
DoCmd.OpenReport "rptPOTerms", acViewNormal, , , acWindowNormal
'This is where I would like the loop to check for the dialog box
SendKeys "%" & "(s)"
printFlag = False
Set PDDocA = CreateObject("AcroExch.PDDoc")
Set PDDocB = CreateObject("AcroExch.PDDoc")
Set PDDocC = CreateObject("AcroExch.PDDoc")
Set PDDocD = CreateObject("AcroExch.PDDoc")
b = PDDocB.Open("S:\P & D\Projects\PO_Temp\rptPO.pdf")
b = PDDocA.Open("S:\P & D\Projects\PO_Temp\rptPOTerms.pdf")
b = PDDocA.InsertPages(-1, PDDocB, 0, 0, True)
b = PDDocA.Save(1, "S:\P & D\Projects\PO_Temp\PO1.pdf")
Sleep 2000
b = PDDocD.Open("S:\P & D\Projects\PO_Temp\qFaxCover.pdf")
b = PDDocC.Open("S:\P & D\Projects\PO_Temp\PO1.pdf")
b = PDDocC.InsertPages(-1, PDDocD, 0, 0, True)
b = PDDocC.Save(1, "S:\P & D\Projects\PO_Temp\" & (PONumber) & ".pdf")
If Dir("S:\P & D\Projects\PO_Temp\" & (PONumber) & ".pdf") = "" Then
Do While Dir("S:\P & D\Projects\PO_Temp\" & (PONumber) & ".pdf") = ""
Sleep 2000
Loop
End If
b = PDDocA.Close
b = PDDocB.Close
b = PDDocD.Close
MailResponse = MsgBox("Would you like to E-mail this PO?", vbYesNo, "Email PO?")
If MailResponse = vbYes Then
AppActivate ("Inbox - Microsoft Outlook")
Sleep 500
SendKeys "^" & "(n)"
Else
Set Application.Printer = Application.Printers("\\server1\KONICA MINOLTA 350/250/200 PS")
End If
Kill ("S:\P & D\Projects\PO_Temp\qFaxCover.pdf")
Kill ("S:\P & D\Projects\PO_Temp\rptPO.pdf")
Kill ("S:\P & D\Projects\PO_Temp\rptPOTerms.pdf")
Kill ("S:\P & D\Projects\PO_Temp\PO1.pdf")
Set Application.Printer = Application.Printers("\\server1\KONICA MINOLTA 350/250/200 PS")
End Sub
I hope this is all easy enough to read. I know there are probably some pieces in there that totally violate best practices, but they work. All except for that send keys command.
Thanks in advance for any help you guys can give.
-Krys