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