Hey Y’all,
All of the sudden the following code no longer works with Late Binding! It still works fine with Early Binding.
Access 2010, Outlook 2010, Win 10 Pro Build 10.0.10586
Fails at the Red highlighted line with error message:
43759-mailitemfailed
Conditional Compilation variables set in VBE Project Properties.
LateBinding = 1 : MyDebug = 0 : conAccessVersionID = 2010
Code:
' +-------------------------+ +----------+
'-------------------------| EmailBills() |-------------| 01/11/12 |
' +-------------------------+ +----------+
'Requires : PDFCreator {Open Source PDF Printer Driver}
' Sleep {Windows API Function Declaration}
'Called By:
'Calls: ClearPDFDirectory()
' SetDateForBills()
' [Utilities] SwitchPrinters()
' [Utilities] zGetDBPath()
Sub EmailBills()
Dim dbName As Database
Dim rst As Recordset
Dim lRecNo As Long
Dim lBillCnt As Long
Dim zWhere As String
Dim zMsgBody As String
#If LateBinding = 0 Then 'Early Binding
Dim appOL As Outlook.Application
Dim miMail As Outlook.mailitem
#Else
Dim appOL As Object
Dim miMail As Object
#End If
Dim oMyAttach As Object
Dim zAttFN As String
Dim zBillPath As String
If Not SetDateForBills() Then
Exit Sub
End If
MsgBox "Please Note:" & vbCrLf & vbCrLf & _
"If Microsoft Outlook is Closed the created Emails " & vbCrLf & _
"will be sent to the INBOX folder." & vbCrLf & vbCrLf & _
"If Microsoft Outlook is OPEN {recommended} the created Emails " _
& vbCrLf & "will be sent to the DRAFTS folder." & vbCrLf & vbCrLf & _
"When OUTLOOK is properly set press OK", _
vbOKOnly + vbInformation, _
"IMPORTANT INFORMATION:"
zBillPath = zGetDBPath() & "EmailBills"
ClearPDFDirectory
strDfltPrt = Application.Printer.DeviceName
SwitchPrinters "PDFCreator"
Set appOL = CreateObject("Outlook.Application")
Set dbName = CurrentDb()
Set rst = dbName.OpenRecordset("Owners", dbOpenDynaset)
rst.MoveFirst
lBillCnt = 0
zMsgBody = "Please find your WPOA annual dues statement attached." & _
vbCrLf & vbCrLf & "WOPA Board of Directors" & vbCrLf & _
vbCrLf & "Attachment: "
Do
If (rst![EMailDocs] And rst![EMail] "") Then
zWhere = "[OwnerID] = " & Str(rst![OwnerID])
'Note: If acNormal is selected the report is send automatically to the
' Default printer!
' If acPreview is selected the report is sent to the screen.
DoCmd.OpenReport "rptAnnualBilling", acNormal, , zWhere
'******* Rename file with OwnerID
On Error GoTo WaitForPDFCreator
Try_Again:
Do While Dir(zBillPath & "rptAnnualBilling.pdf") = vbNullString
Sleep 750 '** wait 1.25 secs before trying again **
Loop
Name zBillPath & "rptAnnualBilling.pdf" As _
zBillPath & "Bill" & Format(rst![OwnerID]) & ".pdf"
On Error GoTo 0
'******* Begin Send Email
#If LateBinding = 0 Then
Set miMail = appOL.CreateItem(olMailItem) '*** olMailItem = 0 ***
#Else
Set miMail = appOL.CreateItem(0)
#End If
With miMail
[SIZE=4][COLOR="#FF0000"] .To = rst![EMail][/COLOR][/SIZE]
.Subject = "WPOA Annual Dues Statement: " & rst![OwnerLName]
.Body = zMsgBody & "Bill" & Trim(Str(rst![OwnerID])) & _
" Owner: " & rst![OwnerLName]
.ReadReceiptRequested = True
zAttFN = zBillPath & "Bill" & _
Trim(Str(rst![OwnerID])) & ".pdf"
Set oMyAttach = miMail.Attachments.Add(zAttFN)
.Save
End With 'miMail
Set miMail = Nothing
lBillCnt = lBillCnt + 1 '*** Count Emails Created ***
'******* End Send Email
End If
rst.MoveNext '*** Move to Next Record ***
Loop Until rst.EOF
MsgBox Format(lBillCnt, "#,###") & " Email Bills Created." & _
vbCrLf & vbCrLf & _
"Maximize Outlook and Press F8 and select the" & _
"SendAllDrafts macro then click Run." & _
vbCrLf & vbCrLf & _
"If Outlook wasn't open when you created the Email" & _
vbCrLf & "Bills you will have to move them to the" & _
vbCrLf & "Drafts folder from the Inbox BEFORE you" & _
vbCrLf & "run the macro!", vbOKOnly + vbInformation, _
"Next Step:"
GoTo GetOut
WaitForPDFCreator:
Select Case Err.Number
Case 75
Sleep 0.75 '*** Wait another 3/4 second. ***
Resume Try_Again
Case Else
MsgBox "Module:" & vbTab & "BillingsCode" & vbCrLf & _
"Routine:" & vbTab & "EmailMailBills" & vbCrLf & _
"Error: " & Err.Number & " " & _
Err.Description, vbCritical + vbOKOnly, _
"Unexpected Error:"
Resume GetOut
End Select
GetOut:
Set rst = Nothing '*** Close RecordSet ***
Set oMyAttach = Nothing
Set miMail = Nothing
Set appOL = Nothing
SwitchPrinters strDfltPrt
End Sub '*** EmailBills() ***
Any Ideas?
:cheers:
