0
votes

Can anyone help me figure out what's going wrong and how to fix it?

I'm trying to automate sending an email with some daily status information. I'd tried automating this from Access but kept running into (known but apparently unsolved) problems with GetObject(, "Outlook.Application") with Windows 8.1 64 and Outlook 2013. So I decided to automate starting from Outlook.

Anyway, I moved the mail message creation code into Outlook vba and had it start Access and run the Access code. This is all well and good until I get to creating the mail message. Everything starts just fine until it gets to writing to the body of message (using Word as the body editor). At the first "TypeText" command, I'm getting the error message in the title. If I click debug on the error notification dialog and then single-step through the line of code in question, it works just fine. I thought that there was some timing problem, so I stuck a 2-second wait in the code. No luck. The code in question, with some other oddities associated with testing (notably trying to type and then delete text), is below:

Public Sub CreateMetrics()
   ' Mail-sending variables
    Dim mailApp As Outlook.Application
    Dim accessApp As Access.Application

    Dim mail As MailItem
    Dim wEditor As Word.Document
    Dim boolCreatedApp As Boolean

    Dim i As Integer

    Set mailApp = Application

    ' Create an Access application object and open the database
    Set accessApp = CreateObject("Access.Application")
    accessApp.OpenCurrentDatabase dbLoc
    accessApp.Visible = True

    ' Open the desired form and run the click event hander for the start button
    accessApp.DoCmd.OpenForm ("ProcessStatus")
    accessApp.Forms![ProcessStatus].StartButton_Click

    ' Create the outgoing mail message
    Set mail = Application.CreateItem(olMailItem)
    mail.Display
    mail.BodyFormat = olFormatHTML
    Set wEditor = mailApp.ActiveInspector.WordEditor

    With accessApp.Forms![ProcessStatus]
        Debug.Print .lblToList.Caption
        Debug.Print .lblSubject.Caption
        Debug.Print .lblIntroduction.Caption
        Debug.Print .lblAttachFilepath.Caption
    End With

        mail.To = accessApp.Forms![ProcessStatus].lblToList.Caption
        mail.Recipients.ResolveAll

        mail.Subject = accessApp.Forms![ProcessStatus].lblSubject.Caption
        mail.Attachments.Add accessApp.Forms![ProcessStatus].lblAttachFilepath.Caption

        Sleep 2000

        ' Error occurs in the next line ***********************************************
        wEditor.Application.Selection.TypeText Text:="Test"
        wEditor.Application.Selection.HomeKey
        wEditor.Application.Selection.Delete Count:=4

        wEditor.Application.Selection.PasteSpecial DataType:=wdPasteBitmap
        wEditor.Application.Selection.HomeKey
        wEditor.Application.Selection.TypeText accessApp.Forms![ProcessStatus].lblIntroduction.Caption
        wEditor.Application.Selection.TypeText Text:=Chr(13) & Chr(13)
        wEditor.Application.Selection.EndKey

'        wEditor.Application.Selection.EndKey
'        wEditor.Application.Selection.TypeText Text:=Chr(13)
'        wEditor.Application.Selection.TypeText Text:=configs("EmailSignature")
'    End With

    With mailApp.Session.Accounts
        i = 1
        Do While i <= .Count
            ' Use either the specified email address OR the last outlook email address
            If RegEx_IsStringMatching(.Item(i).SmtpAddress, accessApp.Forms![ProcessStatus].lblSenderRegex.Caption) Or i = .Count Then
                mail.SendUsingAccount = .Item(i)
                i = .Count + 1
            Else
                i = i + 1
            End If
        Loop
    End With
    mail.Save

    accessApp.Quit
End Sub
1

1 Answers

0
votes

I added a "mail.Display" just before the line that was causing the failure, which seemed, incorrectly, to have fixed the problem.

I have now solved this problem by executing a document.select on the document associated with the email I was creating. To select the right document (there doesn't seem to be any guarantee of which one that would be within the wEditor.Application.Documents collection, though it was typically the first one), I created an almost-certainly unique piece of text and assigned it to the body of the email, which I could then go and find. Here's the new code that I added to the code above: Dim aDoc As Word.Document Dim strUniqueID As String

 . . .

mail.Attachments.Add accessApp.Forms![ProcessStatus].lblAttachFilepath.Caption
strUniqueID = accessApp.Forms![ProcessStatus].lblSubject.Caption & Rnd(Now()) & Now()
mail.Body = strUniqueID

' Search for the unique text. aDoc.Content has extra characters at the
' end, so compare only for the length of the unique text
For Each aDoc In wEditor.Application.Documents
    If Left(aDoc.Content, Len(strUniqueID)) = strUniqueID Then
        aDoc.Select
        mail.Body = ""
    End If
Next aDoc

wEditor.Application.Selection.TypeText Text:="Test"
. . .

I looked at a lot of examples of code that did this kind of thing. None of them performed a select or said anything about needing one. Debugging was made that much harder because the select occured implicitly when the debugger was invoked.