Hi,
I have some code which I have been using for years under Windows XP and Office 2003 that automated Outlook from Access. It has always worked, but now that I have upgraded to Vista and Outlook 2007 (still using Access 2003), I am getting a "429 Error: ActiveX component can't create object" when I try to run the code.
Here is the code, if any experts can point out what needs to be changed I would greatly appreciate it:
Public Function fSendMessage(vForm As Form, vDisplayMsg, vIDOptions As String)
Dim objOutlook As Object
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim dbs As Database
Dim rst As Recordset
Dim vPostID As Long
Dim OrgStr As String
Dim NewStr As String
Dim Position As String
Dim Word As String
Dim sql As String
Dim vWhere As String
'Set vWhere Variable:
Select Case vIDOptions
Case "Active"
vWhere = "(((SummaryPost.PostStatus)='Send') AND ((SummaryPost.ID)=" & vForm.Controls("ID") & "))"
Case "All"
vWhere = "(((SummaryPost.PostStatus)='Send'))"
Case Else
vWhere = "(((SummaryPost.PostStatus)='Send') AND ((SummaryPost." & vIDOptions & "ID)=" & vForm.Controls(vIDOptions & "ID") & "))"
End Select
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT SummaryPost.* " _
& "FROM SummaryPost " _
& "WHERE " & vWhere & ";", DB_OPEN_DYNASET)
Do Until rst.EOF
'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.
If Not IsNull(rst![PostAddressTo]) Then
Set objOutlookRecip = .Recipients.Add(rst![PostAddressTo])
objOutlookRecip.Type = olTo
End If
'Add the Cc recipient(s) to the message.
If Not IsNull(rst![PostAddressCc]) Then
Set objOutlookRecip = .Recipients.Add(rst![PostAddressCc])
objOutlookRecip.Type = olCC
End If
'Add the Bcc recipient(s) to the message.
If Not IsNull(rst![PostAddressBcc]) Then
Set objOutlookRecip = .Recipients.Add(rst![PostAddressBcc])
objOutlookRecip.Type = olBCC
End If
'Set the Subject, Body, and Importance of the message.
If Not IsNull(rst![PostSubject]) Then
.Subject = rst![PostSubject]
End If
If Not IsNull(rst![PostMessage]) Then
.HTMLBody = "<div style='font-family:" & vForm.Controls("PostMessageFont") & ";font-size:" & vForm.Controls("PostMessageSize") & "'>" & Replace(vForm.Controls("PostMessage"), vbLf, "<br>") & "</div>"
' .Body = rst![PostMessage] & fCR1() & vbCrLf
End If
.Importance = olImportanceHigh 'High importance
'Add attachments to the message.
If Not IsNull(rst![PostAttachFile]) Then
OrgStr = Trim(CStr(rst![PostAttachFile])) & " "
NewStr = OrgStr
Do Until Len(NewStr) <= 0
Position = InStr(1, NewStr, " ")
Word = Left(NewStr, Position - 1)
Set objOutlookAttach = .Attachments.Add(Word)
NewStr = LTrim(Right(NewStr, Len(NewStr) - (Len(Word) + 1)))
Loop
End If
'Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
'Should we display the message before sending?
If vDisplayMsg Then
.Display
Else
.Send
End If
End With
Set objOutlook = Nothing
rst.Edit
rst![PostDate] = fDateMedium()
rst![PostStatus] = "Sent"
rst.Update
rst.MoveNext
Loop
rst.Close
End Function
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Most Valuable Expert award recognizes technology experts who passionately share their knowledge with the community, demonstrate the core values of this platform, and go the extra mile in all aspects of their contributions. This award is based off of nominations by EE users and experts. Multiple MVEs may be awarded each year.
The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.