Hi,
I'm pretty new to VBA so I can imagine what I'm doing wrong will be a simple fix but I just seem incapable of figuring it out.
I have tried using Macropod's code when he was answering a similar question but that does not seem to work either in this scenario (
https://www.msofficeforums.com/mail-...html#post61731).
What I am trying to accomplish is when a button is clicked (on a separate excel document purely used to hold the macro), Excel will open the relevant document and make the necessary changes to ensure the formatting is pulled through correctly during the Mail Merge, this is encompassed in Call Adding_Columns. This works as expected.
Next, the macro will open Word and link through to that newly updated excel spreadsheet.
When I run the code below I get 1 of 2 issues, either Word stops responding and I have to force quit, or a new .xls file is created 1 folder above where the data set is stored, I then get a SQL box asking me to select the table in the new .xls document with no options to change the document.
No matter what I've tried I can't seem to get around this issue so would really appreciate some help!
Code below:
Code:
Sub TESTING_W_WORD()
Const strPESREPORT As String = "C:\Users\OllieR\OneDrive\1 - Business Support\Ollie Testing PEHS Macros\ADHB PES Report_Pilot.xlsx"
Const strMailMerge As String = "C:\Users\OllieR\OneDrive\1 - Business Support\Ollie Testing PEHS Macros\Mail Merge Draft 1.docx"
Dim openword As Word.Application
Dim wddoc As Word.Document
Call Adding_Columns
On Error GoTo CreateObj
Set openword = GetObject(, "Word.Application")
GoTo gotApp
CreateObj:
Set openword = CreateObject("Word.Application")
gotApp:
On Error GoTo 0
openword.Visible = True
With openword
.DisplayAlerts = wdAlertsNone
.Documents.Open (strMailMerge)
With ActiveDocument.MailMerge
.MainDocumentType = NotAMergeDocument
.OpenDataSource Name:=strPESREPORT, Format:=wdOpenFormatDocument, linktosource:=True, Revert:=False, _
Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=strPESREPORT;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM 'Sheet1'"
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
openword.DisplayAlerts = wdAlertsAll
End With
Windows("ADHB PES Report_Pilot").Close
End Sub
Adding Columns code (which works as expected)
Code:
Sub Adding_Columns()
Const strPESREPORT As String = "C:\Users\OllieR\OneDrive\1 - Business Support\Ollie Testing PEHS Macros\ADHB PES Report_Pilot.xlsx"
Workbooks.Open (strPESREPORT)
Windows("ADHB PES Report_Pilot.xlsx").Activate
Application.DisplayAlerts = xlAlertsNone
Range("F1").EntireColumn.Insert
Range("F3").Value = "DOB"
Range("F4").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",TEXT(RC[-1],""dd/MM/yyyy""))"
Range("F4").Select
Selection.AutoFill Destination:=Range("F4:F5000"), Type:=xlFillDefault
Range("AJ:AJ").EntireColumn.Insert
Range("AJ3").Value = "Start Date"
Range("AJ4").FormulaR1C1 = "=IF(RC[-1]="""","""",TEXT(RC[-1],""dd/MM/yyyy""))"
Range("AJ4").Select
Selection.AutoFill Destination:=Range("AJ4:AJ5000"), Type:=xlFillDefault
ActiveWorkbook.Save
Application.DisplayAlerts = xlAlertsAll
End Sub