首次使用文档时获得"Object variable or With block variable not set"。键入带有 Outlook 消息的文本



有人能帮我找出问题所在以及如何解决吗?

我正在尝试自动发送一封包含一些日常状态信息的电子邮件。我曾尝试从Access自动执行此操作,但在Windows 8.1 64和Outlook 2013中,GetObject("Outlook.Application")一直遇到(已知但显然未解决)问题。所以我决定从Outlook开始自动化。

无论如何,我把邮件创建代码移到Outlook vba中,让它启动Access并运行Access代码。这一切都很好,直到我开始创建邮件。一切开始都很好,直到写入消息正文(使用Word作为正文编辑器)。在第一个"TypeText"命令中,我得到标题中的错误消息。如果我在错误通知对话框上单击debug,然后单步执行有问题的代码行,它会很好地工作。我认为有一些时间问题,所以我在代码中等待了2秒。运气不好。有问题的代码,以及与测试相关的其他一些奇怪之处(尤其是试图键入然后删除文本)如下:

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

我在导致故障的行之前添加了一个"mail.Display",这似乎错误地解决了问题。

我现在已经通过在与我创建的电子邮件相关联的文档上执行document.select解决了这个问题。为了选择正确的文档(似乎无法保证哪一个文档会在wEditor.Application.Documents集合中,尽管它通常是第一个),我创建了一段几乎可以肯定是唯一的文本,并将其分配到电子邮件的正文中,然后我可以去找到它。以下是我添加到上面代码中的新代码:将文档分帐为Word.DocumentDim strUniqueID为字符串

 . . .
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"
. . .

我看了很多做这种事情的代码示例。他们中没有一个人做过选择,也没有说过需要一个。调试变得更加困难,因为选择是在调用调试器时隐式发生的。

最新更新