文件已锁定,无法编辑

时间:2019-07-23 18:34:10

标签: excel vba ms-word mailmerge

我正在使用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

0 个答案:

没有答案