有人能帮我找出问题所在以及如何解决吗?
我正在尝试自动发送一封包含一些日常状态信息的电子邮件。我曾尝试从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"
. . .
我看了很多做这种事情的代码示例。他们中没有一个人做过选择,也没有说过需要一个。调试变得更加困难,因为选择是在调用调试器时隐式发生的。