Need help please; somewhat new to VBA. Absolutely struggling with this issue.
Issue - Data stored in an excel file; press button; data is transferred to a Word (Merge) doc file. This works fine. Now I struggle in attempting to automate the SaveAs option to save the document. In the code below the string Path when a MSGBOX is inserted is perfect. However, reading and reading I can not get the save to work.
Public Sub openDPIRoleChange()
Dim wd As Object
Dim wdocSource As Object
Dim Answer As String
Dim strWorkbookName As String
Dim Path As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Answer = MsgBox("Is request for Z-Fuel", vbQuestion + vbYesNo, "???")
'Set path to save document
Path = "J:\FPS\FIN\TRAN\BSIP\00 CSWright\DPI Role Change Forms\DPI Role Change Form - " & Range("C4")
If Answer = vbNo Then
Path = Path & ".docx"
Else
Path = Path & " - ZFuel.docx"
End If
If Answer = vbNo Then
Set wdocSource = wd.Documents.Open("J:\FPS\FIN\TRAN\BSIP\00 CSWright\DPI Role Change Forms\DPI Role Change Form - Merge.doc")
Else
Set wdocSource = wd.Documents.Open("J:\FPS\FIN\TRAN\BSIP\00 CSWright\DPI Role Change Forms\DPI Role Change Form - Merge - ZFuel.doc")
End If
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `DPI Role Change$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close SaveChanges:=False
'Save file
' ActiveDocument.SaveAs2 Filename:=Path, _
' FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
' AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
' EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
' :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
Set wdocSource = Nothing
Set wd = Nothing
End Sub
Issue - Data stored in an excel file; press button; data is transferred to a Word (Merge) doc file. This works fine. Now I struggle in attempting to automate the SaveAs option to save the document. In the code below the string Path when a MSGBOX is inserted is perfect. However, reading and reading I can not get the save to work.
Public Sub openDPIRoleChange()
Dim wd As Object
Dim wdocSource As Object
Dim Answer As String
Dim strWorkbookName As String
Dim Path As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Answer = MsgBox("Is request for Z-Fuel", vbQuestion + vbYesNo, "???")
'Set path to save document
Path = "J:\FPS\FIN\TRAN\BSIP\00 CSWright\DPI Role Change Forms\DPI Role Change Form - " & Range("C4")
If Answer = vbNo Then
Path = Path & ".docx"
Else
Path = Path & " - ZFuel.docx"
End If
If Answer = vbNo Then
Set wdocSource = wd.Documents.Open("J:\FPS\FIN\TRAN\BSIP\00 CSWright\DPI Role Change Forms\DPI Role Change Form - Merge.doc")
Else
Set wdocSource = wd.Documents.Open("J:\FPS\FIN\TRAN\BSIP\00 CSWright\DPI Role Change Forms\DPI Role Change Form - Merge - ZFuel.doc")
End If
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `DPI Role Change$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
wd.Visible = True
wdocSource.Close SaveChanges:=False
'Save file
' ActiveDocument.SaveAs2 Filename:=Path, _
' FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
' AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
' EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
' :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
Set wdocSource = Nothing
Set wd = Nothing
End Sub
