我要做的是从 Access 打开一个单词模板，填充一些信息，然后将其附加到电子邮件中。这在Office 2019中工作正常，但是我们的工作计算机正在运行Office 2010，并且似乎每尝试两次/三次后，它都会失败并显示"需要对象"错误。是这一行失败了：
Set oDoc = oWord.Documents.Add("F：\whatever.dotx"(
oWord 在失败时肯定包含 Word 应用程序，所以我真的不明白为什么它在 3/4 次尝试后这样做。
Private Sub Command154_Click()
Dim RecordID As Integer, OrgName As String, RecordComment As Variant, ContactName As String, ContactEmail As String, CName As Variant, ContractEndD As Variant
Dim ContactFirst1, ContactFirst, oWordTbl As Object, newrow As Integer, rowNew As Object, i As Integer, wdDoNotSaveChanges, myAttachments, ContractEnd, newfilename As String
OrgName = Me.OrganisationName
ContactName = Me.ContactName
ContactEmail = Me.Email_1
CName = Me.CName1
RecordID = Me.CommID
RecordComment = ContactName & " - " & ContactEmail
ContractEndD = Me.ContractEndDate
If IsNull(ContractEndD) Then ContractEndD = "<span style='background:yellow;mso-highlight:yellow'>[DD/MM/YYYY]</span>"
If Not IsNull(ContactName) Then
ContactFirst1 = Split(ContactName)
ContactFirst = ContactFirst1(0)
End If
Dim oWord As Object, iRecCount As Integer, iFldCount As Integer, j As Integer
Set oWord = CreateWord
oWord.Visible = True
Dim oDoc As Object
Set oDoc = oWord.Documents.Add("F:whatever.dotx")
Dim cnStr As String
Dim cn As ADODB.Connection
Dim cnRs As New ADODB.Recordset
Set cn = CurrentProject.Connection
cnRs.Open "SELECT CName1, CEmail1,TypeOfContact FROM Comms WHERE ContactID = " & Me.ContactID & ";", cn, adOpenKeyset
With cnRs
If .RecordCount <> 0 Then
.MoveLast 'Ensure proper count
iRecCount = .RecordCount 'Number of records returned by the table/query
.MoveFirst
iFldCount = .Fields.Count 'Number of fields/columns returned by the table/query
End If
Debug.Print iRecCount
Set oWordTbl = oDoc.Tables(1)
For newrow = 1 To iRecCount
Set rowNew = oWordTbl.Rows.Add(BeforeRow:=oWordTbl.Rows(3))
Next newrow
'Build our data rows
For i = 1 To iRecCount
oWordTbl.Cell(i + 2, 2) = Nz(cnRs![CName1], "")
oWordTbl.Cell(i + 2, 3) = Nz(cnRs![CEmail1], "")
oWordTbl.Cell(i + 2, 4) = Nz(cnRs![TypeOfContact], "")
.MoveNext
Next i
End With
With oDoc
.SaveAs "H:whatever.docx"
.Close SaveChanges:=wdDoNotSaveChanges
End With
If oWord.Documents.Count = 0 Then oWord.Quit
'----------------------------
Dim objOutlook As Object, objEmail As Object, EmailTemplate As String
Set objOutlook = CreateObject("Outlook.application")
EmailTemplate = "F:whatever.oft"
Set objEmail = objOutlook.CreateItemFromTemplate(EmailTemplate)
With objEmail
Set myAttachments = .Attachments
myAttachments.Remove 1
myAttachments.Add "H:whatever.docx"
.To = Nz(ContactEmail)
.Display
End With
newfilename = Format(Now(), "yyyy-mm-dd-hh-mm-ss") & " - " & OrgName & ".docx"
Name "H:whatever.docx" As "H:whatever" & newfilename
Set objOutlook = Nothing
Set objEmail = Nothing
Set oWord = Nothing
Set oDoc = Nothing
End Sub
Private Function CreateWord(Optional bVisible As Boolean = True) As Object
Dim oTempWD As Object
On Error Resume Next
Set oTempWD = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
On Error GoTo ERROR_HANDLER
Set oTempWD = CreateObject("Word.Application")
End If
oTempWD.Visible = bVisible
Set CreateWord = oTempWD
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure CreateWord."
Err.Clear
End Select
End Function
我确实解决了这个问题。问题是将指向模板的链接放在oWord.Documents.Add((中。当我先将模板放入变量中，然后在函数中调用变量时，它工作正常。
Dim strFilename As String
strFilename = "F:whatever.dotx"
Set oDoc = oWord.Documents.Add(strFilename)