troubleshooting Question

Just switched to Vista, getting dreaded 429 (ActiveX) Error when automating Outlook from Access.

Avatar of MitchellVII
MitchellVIIFlag for United States of America asked on
Microsoft Access
5 Comments1 Solution319 ViewsLast Modified:
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
ASKER CERTIFIED SOLUTION
Log in to continue reading
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform for $9.99/mo
View membership options
Unlock 1 Answer and 5 Comments.
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
The Value of Experts Exchange in My Daily IT Life

Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>

Mike

Owner of Outages.IO
Phoenix, Arizona, United States
Member Since 2016
Join a full scale community that combines the best parts of other tools into one platform.
Unlock 1 Answer and 5 Comments.
View membership options
“All of life is about relationships, and EE has made a virtual community a real community. It lifts everyone's boat.”
William Peck

Member since 2004