我正在使用Excel来运行邮件合并,并且一切正常,“ EXCEPT” ...
创建文档后,它们也会被锁定以进行编辑。如果我尝试删除一个,则会弹出一个对话框,指出该操作无法完成,因为该文档是在“ Word(桌面)”中打开的。如果我尝试打开它或其他任何内容,则只能将其作为只读副本打开。 我到处都在问,似乎没人知道,因为没人回应!
任何帮助将不胜感激
Private Sub cmdgenerateNG_Click()
Dim bCreatedWordInstance As Boolean
Dim objWord As Object
Dim objMMMD As Object
Dim SMName As String
Dim cDir As String
Dim r As Long
Dim s As Long
Dim ThisFileName As String
Dim ws1 As Worksheet
Set ws1 = Sheets("Release LettersNG")
Application.ScreenUpdating = False
LastRow = Sheets("Release LettersNG").Range("B" & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To LastRow
SMName = Sheets("Release LettersNG").Cells(r, 2).Value
' Setup filenames
Const WTempName = "MailMergeMainDocumentNG.docx" 'This is the Word Templates name, Change as req'd
Dim NewFileName As String
' Setup directories
cDir = ActiveWorkbook.Path + "\" 'Change if appropriate
ThisFileName = ThisWorkbook.Name
On Error Resume Next
' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = New 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 `Release LettersNG$`" ' Set this as required
With objMMMD.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = r - 1
.LastRecord = r - 1
.ActiveRecord = r - 1
End With
.Execute Pause:=False
End With
End With
On Error Resume Next ' Save new file
NewFileName = SMName & "- ARNG Release Letter -" & Format(Date, "dd mmm yyyy") & ".docx" ' 'This is the New Word Document File Name
objWord.ActiveDocument.SaveAs cDir + "\Completed Files\" + NewFileName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
'objWord.ActiveDocument.PrintOut
' Close the Mail Merge Main Document
objMMMD.Close savechanges:=wdDoNotSaveChanges
Set objMMMD = Nothing
' Close the New Mail Merged Document
If bCreatedWordInstance = True Then
If Not (objWord Is Nothing) Then
objWord.Close (False)
Set objWord = Nothing
End If
End If
Next r
objWord.Deactivate
objWord.Close
Set objWord = Nothing: Set objMMMD = Nothing
objWord.Quit
Application.ScreenUpdating = False
MsgBox "ARNG Letters have been successfully created!", vbOKOnly, "NOTICE"
End Sub