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
If that doesn't work, can you pinpoint the line where your error occurs?