Vba 为什么这个宏这么慢?

Vba 为什么这个宏这么慢?,vba,ms-word,mailmerge,Vba,Ms Word,Mailmerge,此宏打开Word文档(以合并字段作为占位符的信函),并执行邮件合并以填写信函的发件人信息。它还提示用户输入自定义值以填写收件人的姓名和地址(填写,而不是合并字段) 发件人的信息存储在Excel电子表格中。第一个提示是输入登录ID,该ID对于每个发件人都是唯一的。宏可以工作,但效率低下。打开.docx需要几秒钟,当光标旋转时,用户不知道发生了什么。我加了一个信息框,告诉他们要有耐心,诸如此类。有没有办法使.docx文档打开得更快?仅供参考,我从这个网站上找到的其他代码片段构建了这个宏。我不是VBA

此宏打开Word文档(以合并字段作为占位符的信函),并执行邮件合并以填写信函的发件人信息。它还提示用户输入自定义值以填写收件人的姓名和地址(填写,而不是合并字段)

发件人的信息存储在Excel电子表格中。第一个提示是输入登录ID,该ID对于每个发件人都是唯一的。宏可以工作,但效率低下。打开.docx需要几秒钟,当光标旋转时,用户不知道发生了什么。我加了一个信息框,告诉他们要有耐心,诸如此类。有没有办法使.docx文档打开得更快?仅供参考,我从这个网站上找到的其他代码片段构建了这个宏。我不是VBA的专家…:(

电子表格如下所示:

更新: 根据Charles Kenyon的建议,我修改了如下所示的代码,但现在我收到了两次输入提示,以填充FILLIN字段

Sub Letter_V2()
Dim myKey As String
Dim mySource As String: mySource = "C:\LetterMemoDB.xls"

Documents.Add Template:="C:\ NewLetterTemplate.docx", NewTemplate:=False
 myKey = InputBox("Enter sender's login ID (e.g., jtorres or b324):")
    With ActiveDocument.MailMerge
        .MainDocumentType = wdFormLetters
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .OpenDataSource Name:=mySource, ReadOnly:=True, AddToRecentFiles:=False, _
          LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
          "Data Source=mySource;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
          SQLStatement:="SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
        .Execute Pause:=False
    End With

End Sub
--2021年6月4日更新-我再次更改了宏。添加了对Office 2016 Word对象库的引用,并将代码更改如下。可能我仍然不理解“早期绑定”与“后期绑定”


您正在打开Word文档并附加源代码。这永远不会是即时的。如果已使用Word open从Word运行,它的运行速度会更快。谢谢Charles Kenyon。请参阅主要帖子中的更新。有什么想法吗?您的代码很慢,因为您使用的是后期绑定。据MS称,早期绑定的运行速度将是以前的两倍。^^^^^^ I a添加对Word对象库的引用,并将宏放在自己的模块中,以“Option Explicit”开头。我将Dim wrdObj作为对象,wrdDoc作为对象更改为Dim wrdObj作为Word.Application Dim wrdDoc作为Word.Document,并设置wrdObj=CreateObject(“Word.Application”)仍然运行得非常慢…还有其他想法吗?
Sub Letter_V2()
Dim myKey As String
Dim mySource As String: mySource = "C:\LetterMemoDB.xls"

Documents.Add Template:="C:\ NewLetterTemplate.docx", NewTemplate:=False
 myKey = InputBox("Enter sender's login ID (e.g., jtorres or b324):")
    With ActiveDocument.MailMerge
        .MainDocumentType = wdFormLetters
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .OpenDataSource Name:=mySource, ReadOnly:=True, AddToRecentFiles:=False, _
          LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
          "Data Source=mySource;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
          SQLStatement:="SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
        .Execute Pause:=False
    End With

End Sub
Option Explicit

Sub Letter()
Dim wrdObj As Word.Application
Dim wrdDoc As Word.Document
Dim excObj As Excel.Application
Dim strFile As String, myKey As String
Dim mySource As String: mySource = "C:\LetterMemoDB.xls"

Set wrdObj = CreateObject("Word.Application")
Set excObj = CreateObject("Excel.Application")

myKey = InputBox("Enter sender's login ID (e.g., jtorres or b324):")
'MsgBox ("Please wait a moment. If the template doesn't automatically open, go to the Word icon in the taskbar and open it from there. ")
With wrdObj
    .Visible = True
    .Activate
    .DisplayAlerts = wdAlertsNone
        Set wrdDoc = .Documents.Open("C:\NewLetterTemplate.docx", False, True, False, , , , , , , , False)
        With wrdDoc
            With .MailMerge
                .MainDocumentType = wdFormLetters
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
                .OpenDataSource Name:=mySource, ReadOnly:=True, AddToRecentFiles:=False, _
                  LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
                  "Data Source=mySource;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
                  SQLStatement:="SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
                .Execute Pause:=True
            End With
    .Close 0
        End With
    .Activate
End With
Set wrdDoc = Nothing: Set wrdObj = Nothing
Close excObj
Set excObj = Nothing
End Sub