This action cannot be completed because the file is open in word desktop


Board Regular
May 23, 2019
I am trying to use VBA to print some word docs that were just generated through Mail Merge code, and for some reason I keep getting this message" This action cannot be completed because the file is open in word desktop". Not sure why, but am pretty sure the problem is in the Mail Merge code. Its as if Word is not closing. I also see a message that says it is waiting on another application to finish an OLE process, but never both.
Below is my code. Any help would be helpful on how to kill Word when done creating letters...

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 wsl As Worksheet
Set ws1 = Sheets("Release LettersNG")

 LastRow = Sheets("Release LettersNG").Range("B" & Rows.Count).End(xlUp).Row
 r = 2
 For r = 2 To LastRow
 If Cells(r, 25).Value = "DONE" Then GoTo nextrow
 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 = GetObject(, "Word.Application")
 Set objWord = New Word.Application
 If objWord Is Nothing Then
Set objWord = CreateObject("Word.Application")
bCreatedWordInstance = True
 End If
 If objWord Is Nothing Then
 MsgBox "Could not start Word"
 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)
 'Merge the data
 With objMMMD
 .MailMerge.OpenDataSource Name:=cDir + "\" + ThisFileName, sqlstatement:="SELECT * FROM `Release LettersNG$`" ' Set this as required
 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
 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 Documents File Name, Change as req'd"
 objWord.ActiveDocument.SaveAs cDir + "\Completed NG Letters\" + NewFileName
 ' Close the Mail Merge Main Document
 objMMMD.Close savechanges:=wdDoNotSaveChanges
 Set objMMMD = Nothing
 ' Close the New Mail Merged Document
 If bCreatedWordInstance Then
 If Not (objWord Is Nothing) Then
    objWord.Close (False)
    Set objWord = Nothing
End If
 End If
 For s = 1 To LastRow
 Sheets("Release LettersNG").Cells(s, 25).Value = "DONE"
 Next s
MsgBox "Letters Complete!", vbOKOnly, "NOTICE"
End Sub

Private Sub cmdprint_Click()

  Dim objWordApplication As New Word.Application
  Dim strFile As String
  Dim strFolder As String
  Dim FSO As Object
    cDir = ActiveWorkbook.Path
     If Me.cmbcomp.Value = "USAR" Then
     pth = "Completed AR Letters\"
     Else:  pth = "Completed NG Letters\"
     End If
  strFolder = cDir + "\" + pth
  strFile = Dir(strFolder & "*.docx", vbNormal)
  Set FSO = CreateObject("Scripting.Filesystemobject")
  While strFile <> ""
    With objWordApplication
      .Documents.Open (strFolder & strFile)
      FSO.MoveFile Source:=strFolder & strFile, Destination:=cDir + "\" + "Completed Files\" + strFile
    End With
    strFile = Dir()
  Set objWordApplication = Nothing
End Sub

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.


Board Regular
May 23, 2019
UPDATE: Seems that all files generated are also now being appended as "Read Only"...Ugh, very frustrating.
I am puzzled because this was working fine last week.

Watch MrExcel Video

Forum statistics

Latest member