Question

早上好

我试图清理一个行为不稳定的宏。它曾经工作 - 在美好的一天。但它引发了这个错误：＆＃34; Microsoft Excel正在等待另一个应用程序完成OLE操作＆＃34;。我已经尝试清理它（导致各种其他错误，现在已经排序），我又回到能够逐步完成它但它再次停在上面的错误。

我注意到它曾经做过一个证书然后抛出错误，但现在当它试图打开模板时会立即发生错误。这是一行：设置objMMMD = objWord.Documents.Open（cDir＆amp; WTempName） objMMMD.Activate

我最初的想法是，代码并没有干净地关闭Word，但现在错误是如此早，那不可能。我没有打开Word。 - 因为它在修改之前用于打开Word，所以代码也应该是正确的。

除了由于超时以及如何抑制消息而在更复杂的代码中出现之外，我无法找到错误。这里似乎都没有帮助。

整个代码下方。有没有人知道为什么Excel无法打开Word来执行mailmerge？

Public Sub MailMergeCert()

Dim bCreatedWordInstance As Boolean
Dim objWord As Word.Application
Dim objMMMD As Word.Document

Dim FirstName As String
Dim LastName As String
Dim Training As String
Dim SeminarDate As String
Dim HoursComp As String
Dim Location As String
Dim Objectives As String
Dim Trainer As String

Dim cDir As String
Dim ThisFileName As String

'Your Sheet names need to be correct in here
Dim sh1 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("Ultrasound")

Dim r As Long
r = 2

FirstName = sh1.Cells(r, 1).Value
LastName = sh1.Cells(r, 2).Value
Training = sh1.Cells(r, 3).Value
SeminarDate = Format(sh1.Cells(r, 4).Value, "d mmmm YYYY")
HoursComp = sh1.Cells(r, 5).Value
Location = sh1.Cells(r, 6).Value
Objectives = sh1.Cells(r, 7).Value
Trainer = sh1.Cells(r, 8).Value

'Setup filenames
Const WTempName = "Certificate_Ultrasound_2017.docx" 'Template name

'Data Source Location
cDir = ActiveWorkbook.Path + "\" 'Change if required
ThisFileName = ThisWorkbook.Name

On Error Resume Next

'Create Word instance
bCreatedWordInstance = False
Set objWord = CreateObject("Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
  End If

If objWord Is Nothing Then
    MsgBox "Could not start Word"
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

' Let Word trap the errors
On Error GoTo 0

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir & WTempName)
objMMMD.Activate

'Merge the data
With objMMMD
    .MailMerge.OpenDataSource Name:=cDir & ThisFileName, _
        sqlstatement:="SELECT *  FROM `Ultrasound$`"   ' Set this as required

lastrow = Sheets("Ultrasound").Range("A" & Rows.Count).End(xlUp).Row


        For r = 2 To lastrow
        If IsEmpty(Cells(r, 11).Value) = False Then GoTo nextrow

            With objMMMD.MailMerge  'With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True

            With .DataSource
                 .FirstRecord = r - 1
                .LastRecord = r - 1
                .ActiveRecord = r - 1
            End With
            .Execute Pause:=False
            End With

'Save new file PDF
Dim UltrasoundCertPath As String
UltrasoundCertPath = "C:\Users\305015724\Documents\ApplicationsTraining\2016\Ultrasound\"
Dim YYMM As String
YYMM = Format(sh1.Cells(r, 16).Value, "YYMM")
Dim NewFileNamePDF As String
NewFileNamePDF = YYMM & "_" & sh1.Cells(r, 3).Value & "_" & sh1.Cells(r, 7).Value '& ".pdf" 'Change File Name as req'd"
objWord.ActiveDocument.ExportAsFixedFormat UltrasoundCertPath & NewFileNamePDF, ExportFormat:=wdExportFormatPDF

nextrow:
        Next r

End With


' Close the Mail Merge Main Document
objMMMD.Close savechanges:=wdDoNotSaveChanges
Set objMMMD = Nothing
If bCreatedWordInstance Then
objWord.Quit
End If

Set objWord = Nothing
Cells(r, 11).Value = Date

0:
Set objWord = Nothing

End Sub

Answer 1

尝试更改

AmazonS3 s3Client = AmazonS3ClientBuilder.standard().build();

要

cDir = ActiveWorkbook.Path + "\"

这会有所作为吗？如果期望的话，也可以尝试打印cDir。

尝试使用cDir消息框检查路径。

cDir = ActiveWorkbook.Path & "\"

Excel中的VBA MailMerge - 等待OLE操作的错误消息

1 个答案: