T
TheNovice
All,
Can someone please guide me to what I am doing wrong!?!?!?!
I have been cookie cutting help from others and this is what I have come up
with. but the thing is, it works for everything else but I am hitting a wall
when it comes to e-mailing the files.
Here is a copy of the code.
Private Sub Command46_Click()
Dim db As Database
Set db = CurrentDb
Dim rc As Recordset
Dim rpt0 As Report
Dim rpt1 As Report
Dim rpt2 As Report
Dim rpt3 As Report
Dim stRCType As String
Dim stCustNum As String
Dim stPrnDoc As String
Dim stEMailDoc As String
Dim stFaxDoc As String
Dim stToName As String
Dim stSubjLine As String
Dim stBody As String
'Set rpt0 = Reports!rptRecallForm00
'Set rpt1 = Reports!rptRecallForm01
'Set rpt2 = Reports!rptRecallForm02
'Set rpt3 = Reports!rptRecallForm03
DoCmd.OpenReport "rptRecallForm00", acViewDesign
DoCmd.OpenReport "rptRecallForm01", acViewDesign
DoCmd.OpenReport "rptRecallForm02", acViewDesign
DoCmd.OpenReport "rptRecallForm03", acViewDesign
Set rpt0 = Reports!rptRecallForm00
Set rpt1 = Reports!rptRecallForm01
Set rpt2 = Reports!rptRecallForm02
Set rpt3 = Reports!rptRecallForm03
rpt0.Visible = False
rpt1.Visible = False
rpt2.Visible = False
rpt3.Visible = False
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryAutoprintList"
DoCmd.SetWarnings True
Set rc = db.OpenRecordset("tmpRecallForAutoPrint")
If Not (rc.BOF And rc.EOF) Then
rc.MoveFirst
Do Until rc.EOF
stPrnDoc = rc!MailYN
stEMailDoc = rc!emailYN
stFaxDoc = rc!faxyn
' This will print all of the documents that have a TRUE in the
print field
If stPrnDoc = True Then
If Me!Report0 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm00", acViewDesign
Set rpt0 = Reports!rptRecallForm00
PrintSnapShot0 stCustNum, rpt0
DoCmd.Close acReport, "rptRecallForm00", acSaveNo
End If
If Me!Report1 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm01", acViewDesign
Set rpt1 = Reports!rptRecallForm01
PrintSnapShot1 stCustNum, rpt1
DoCmd.Close acReport, "rptRecallForm01", acSaveNo
End If
If Me!Report2 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm02", acViewDesign
Set rpt2 = Reports!rptRecallForm02
PrintSnapShot2 stCustNum, rpt2
DoCmd.Close acReport, "rptRecallForm02", acSaveNo
End If
If Me!Report3 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm03", acViewDesign
Set rpt3 = Reports!rptRecallForm03
PrintSnapShot3 stCustNum, rpt3
DoCmd.Close acReport, "rptRecallForm03", acSaveNo
End If
End If
' This will email all of the documents that have a TRUE in the
Email field
If stEMailDoc = True Then
SendMessage False, "c:\common\"
End If
' This will FAX all of the documents that have a TRUE in the FAX
field
If stFaxDoc = True Then
End If
rc.MoveNext
Loop
End If
DoCmd.SetWarnings False
DoCmd.Close acReport, "rptRecallForm00", acSaveNo
DoCmd.Close acReport, "rptRecallForm01", acSaveNo
DoCmd.Close acReport, "rptRecallForm02", acSaveNo
DoCmd.Close acReport, "rptRecallForm03", acSaveNo
Exit Sub
End Sub
Sub PrintSnapShot0(stCustNum As String, rpt0 As Report)
rpt0.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report0 = True Then
DoCmd.OpenReport "rptRecallForm00", acNormal
End If
End Sub
Sub PrintSnapShot1(stCustNum As String, rpt1 As Report)
rpt1.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report1 = True Then
DoCmd.OpenReport "rptRecallForm01", acNormal
End If
End Sub
Sub PrintSnapShot2(stCustNum As String, rpt2 As Report)
rpt2.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report2 = True Then
DoCmd.OpenReport "rptRecallForm02", acNormal
End If
End Sub
Sub PrintSnapShot3(stCustNum As String, rpt3 As Report)
rpt3.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report3 = True Then
DoCmd.OpenReport "rptRecallForm03", acNormal
End If
End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click
Dim stDocName As String
stDocName = "BrptRecallForm00"
DoCmd.OpenReport stDocName, acNormal
Exit_Command47_Click:
Exit Sub
Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click
End Sub
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
'Dim DisplayMsg As Boolean
'Optional AttachmentPath
Dim objOutlook As Outlook.Application 'This is where I am getting the
error
' I dont see how, or is there something that I am missing
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
'build the files to send
PDFCreateB4Send stCustNum, rpt0, rpt1, rpt2, rpt3, stToName, stSubjLine,
stBody
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(stToName)
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Michael Suyama")
'objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
' Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
' objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add("c:\common\recall00.pdf")
Set objOutlookAttach = .Attachments.Add("c:\common\recall01.pdf")
Set objOutlookAttach = .Attachments.Add("c:\common\recall02.pdf")
Set objOutlookAttach = .Attachments.Add("c:\common\recall03.pdf")
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Sub PDFCreateB4Send(stCustNum As String, rpt0 As Report, rpt1 As Report,
rpt2 As Report, rpt3 As Report, stToName As String, stSubjLine As String,
stBody As String)
Dim stDocName0 As String
Dim stDocName1 As String
Dim stDocName2 As String
Dim stDocName3 As String
stDocName0 = "rptRecallForm00"
stDocName1 = "rptRecallForm01"
stDocName2 = "rptRecallForm02"
stDocName3 = "rptRecallForm03"
rpt0.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName0, "snapshot format",
"c:\common\Recall00.snp"
rpt1.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName1, "snapshot format",
"c:\common\Recall01.snp"
rpt2.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName2, "snapshot format",
"c:\common\Recall02.snp"
rpt3.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName3, "snapshot format",
"c:\common\Recall03.snp"
Dim blRet As Boolean
Dim sPDF0 As String
Dim sPDF1 As String
Dim sPDF2 As String
Dim sPDF3 As String
Dim sName0 As String
Dim sName1 As String
Dim sName2 As String
Dim sName3 As String
sName0 = "c:\common\recall00.snp"
sName1 = "c:\common\recall01.snp"
sName2 = "c:\common\recall02.snp"
sName3 = "c:\common\recall03.snp"
If Len(sName0 & vbNullString) = 0 Then Exit Sub
If Len(sName1 & vbNullString) = 0 Then Exit Sub
If Len(sName2 & vbNullString) = 0 Then Exit Sub
If Len(sName3 & vbNullString) = 0 Then Exit Sub
sPDF0 = Mid(sName0, 1, Len(sName0) - 3)
sPDF1 = Mid(sName1, 1, Len(sName1) - 3)
sPDF2 = Mid(sName2, 1, Len(sName2) - 3)
sPDF3 = Mid(sName3, 1, Len(sName3) - 3)
blRet = ConvertReportToPDF(vbNullString, sName0, sPDF0 & "PDF",
False, False)
blRet = ConvertReportToPDF(vbNullString, sName1, sPDF1 & "PDF",
False, False)
blRet = ConvertReportToPDF(vbNullString, sName2, sPDF2 & "PDF",
False, False)
blRet = ConvertReportToPDF(vbNullString, sName3, sPDF3 & "PDF",
False, False)
End Sub
Can someone please guide me to what I am doing wrong!?!?!?!
I have been cookie cutting help from others and this is what I have come up
with. but the thing is, it works for everything else but I am hitting a wall
when it comes to e-mailing the files.
Here is a copy of the code.
Private Sub Command46_Click()
Dim db As Database
Set db = CurrentDb
Dim rc As Recordset
Dim rpt0 As Report
Dim rpt1 As Report
Dim rpt2 As Report
Dim rpt3 As Report
Dim stRCType As String
Dim stCustNum As String
Dim stPrnDoc As String
Dim stEMailDoc As String
Dim stFaxDoc As String
Dim stToName As String
Dim stSubjLine As String
Dim stBody As String
'Set rpt0 = Reports!rptRecallForm00
'Set rpt1 = Reports!rptRecallForm01
'Set rpt2 = Reports!rptRecallForm02
'Set rpt3 = Reports!rptRecallForm03
DoCmd.OpenReport "rptRecallForm00", acViewDesign
DoCmd.OpenReport "rptRecallForm01", acViewDesign
DoCmd.OpenReport "rptRecallForm02", acViewDesign
DoCmd.OpenReport "rptRecallForm03", acViewDesign
Set rpt0 = Reports!rptRecallForm00
Set rpt1 = Reports!rptRecallForm01
Set rpt2 = Reports!rptRecallForm02
Set rpt3 = Reports!rptRecallForm03
rpt0.Visible = False
rpt1.Visible = False
rpt2.Visible = False
rpt3.Visible = False
DoCmd.SetWarnings False
DoCmd.OpenQuery "qryAutoprintList"
DoCmd.SetWarnings True
Set rc = db.OpenRecordset("tmpRecallForAutoPrint")
If Not (rc.BOF And rc.EOF) Then
rc.MoveFirst
Do Until rc.EOF
stPrnDoc = rc!MailYN
stEMailDoc = rc!emailYN
stFaxDoc = rc!faxyn
' This will print all of the documents that have a TRUE in the
print field
If stPrnDoc = True Then
If Me!Report0 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm00", acViewDesign
Set rpt0 = Reports!rptRecallForm00
PrintSnapShot0 stCustNum, rpt0
DoCmd.Close acReport, "rptRecallForm00", acSaveNo
End If
If Me!Report1 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm01", acViewDesign
Set rpt1 = Reports!rptRecallForm01
PrintSnapShot1 stCustNum, rpt1
DoCmd.Close acReport, "rptRecallForm01", acSaveNo
End If
If Me!Report2 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm02", acViewDesign
Set rpt2 = Reports!rptRecallForm02
PrintSnapShot2 stCustNum, rpt2
DoCmd.Close acReport, "rptRecallForm02", acSaveNo
End If
If Me!Report3 = True Then
stCustNum = rc!CustNum
DoCmd.OpenReport "rptRecallForm03", acViewDesign
Set rpt3 = Reports!rptRecallForm03
PrintSnapShot3 stCustNum, rpt3
DoCmd.Close acReport, "rptRecallForm03", acSaveNo
End If
End If
' This will email all of the documents that have a TRUE in the
Email field
If stEMailDoc = True Then
SendMessage False, "c:\common\"
End If
' This will FAX all of the documents that have a TRUE in the FAX
field
If stFaxDoc = True Then
End If
rc.MoveNext
Loop
End If
DoCmd.SetWarnings False
DoCmd.Close acReport, "rptRecallForm00", acSaveNo
DoCmd.Close acReport, "rptRecallForm01", acSaveNo
DoCmd.Close acReport, "rptRecallForm02", acSaveNo
DoCmd.Close acReport, "rptRecallForm03", acSaveNo
Exit Sub
End Sub
Sub PrintSnapShot0(stCustNum As String, rpt0 As Report)
rpt0.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report0 = True Then
DoCmd.OpenReport "rptRecallForm00", acNormal
End If
End Sub
Sub PrintSnapShot1(stCustNum As String, rpt1 As Report)
rpt1.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report1 = True Then
DoCmd.OpenReport "rptRecallForm01", acNormal
End If
End Sub
Sub PrintSnapShot2(stCustNum As String, rpt2 As Report)
rpt2.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report2 = True Then
DoCmd.OpenReport "rptRecallForm02", acNormal
End If
End Sub
Sub PrintSnapShot3(stCustNum As String, rpt3 As Report)
rpt3.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
If Me!Report3 = True Then
DoCmd.OpenReport "rptRecallForm03", acNormal
End If
End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click
Dim stDocName As String
stDocName = "BrptRecallForm00"
DoCmd.OpenReport stDocName, acNormal
Exit_Command47_Click:
Exit Sub
Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click
End Sub
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
'Dim DisplayMsg As Boolean
'Optional AttachmentPath
Dim objOutlook As Outlook.Application 'This is where I am getting the
error
' I dont see how, or is there something that I am missing
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
'build the files to send
PDFCreateB4Send stCustNum, rpt0, rpt1, rpt2, rpt3, stToName, stSubjLine,
stBody
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(stToName)
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Michael Suyama")
'objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
' Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
' objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add("c:\common\recall00.pdf")
Set objOutlookAttach = .Attachments.Add("c:\common\recall01.pdf")
Set objOutlookAttach = .Attachments.Add("c:\common\recall02.pdf")
Set objOutlookAttach = .Attachments.Add("c:\common\recall03.pdf")
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Sub PDFCreateB4Send(stCustNum As String, rpt0 As Report, rpt1 As Report,
rpt2 As Report, rpt3 As Report, stToName As String, stSubjLine As String,
stBody As String)
Dim stDocName0 As String
Dim stDocName1 As String
Dim stDocName2 As String
Dim stDocName3 As String
stDocName0 = "rptRecallForm00"
stDocName1 = "rptRecallForm01"
stDocName2 = "rptRecallForm02"
stDocName3 = "rptRecallForm03"
rpt0.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName0, "snapshot format",
"c:\common\Recall00.snp"
rpt1.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName1, "snapshot format",
"c:\common\Recall01.snp"
rpt2.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName2, "snapshot format",
"c:\common\Recall02.snp"
rpt3.Filter = "CustNum = " & Chr(34) & stCustNum & Chr(34)
DoCmd.OutputTo acOutputReport, stDocName3, "snapshot format",
"c:\common\Recall03.snp"
Dim blRet As Boolean
Dim sPDF0 As String
Dim sPDF1 As String
Dim sPDF2 As String
Dim sPDF3 As String
Dim sName0 As String
Dim sName1 As String
Dim sName2 As String
Dim sName3 As String
sName0 = "c:\common\recall00.snp"
sName1 = "c:\common\recall01.snp"
sName2 = "c:\common\recall02.snp"
sName3 = "c:\common\recall03.snp"
If Len(sName0 & vbNullString) = 0 Then Exit Sub
If Len(sName1 & vbNullString) = 0 Then Exit Sub
If Len(sName2 & vbNullString) = 0 Then Exit Sub
If Len(sName3 & vbNullString) = 0 Then Exit Sub
sPDF0 = Mid(sName0, 1, Len(sName0) - 3)
sPDF1 = Mid(sName1, 1, Len(sName1) - 3)
sPDF2 = Mid(sName2, 1, Len(sName2) - 3)
sPDF3 = Mid(sName3, 1, Len(sName3) - 3)
blRet = ConvertReportToPDF(vbNullString, sName0, sPDF0 & "PDF",
False, False)
blRet = ConvertReportToPDF(vbNullString, sName1, sPDF1 & "PDF",
False, False)
blRet = ConvertReportToPDF(vbNullString, sName2, sPDF2 & "PDF",
False, False)
blRet = ConvertReportToPDF(vbNullString, sName3, sPDF3 & "PDF",
False, False)
End Sub