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

chipsworld

Board Regular
Joined
May 23, 2019
Messages
164
Office Version
  1. 365
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...

Code:
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
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 '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"
nextrow:
 Next s
 Next
 objWord.Quit
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)
      '.ActiveDocument.PrintOut
      .ActiveDocument.Close
      FSO.MoveFile Source:=strFolder & strFile, Destination:=cDir + "\" + "Completed Files\" + strFile
    End With
    strFile = Dir()
  Wend
 
  Set objWordApplication = Nothing
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
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.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,876
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top