Hi All,
I've just shot myself in the foot, I've been up all night trying to make this work but keep failing.. I've had a working mail merge and it came up with a 'compatibility fix' and I did it and now it messed up my code I think!
I've done a trial and error and it seems that my mail merge in word will not run unless my excel file is saved however this wasn't the case before?
I've attached my mail merge code from word and excel and I hope there is some way around this...
Thank you
Edit - Sorry for the title, didn't know X was a curse!..
I've just shot myself in the foot, I've been up all night trying to make this work but keep failing.. I've had a working mail merge and it came up with a 'compatibility fix' and I did it and now it messed up my code I think!
I've done a trial and error and it seems that my mail merge in word will not run unless my excel file is saved however this wasn't the case before?
I've attached my mail merge code from word and excel and I hope there is some way around this...
Thank you
VBA Code:
Sub Mail_Merge21()
'
' MAIL MERGE FOR TEMPLATE 1
'
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Dim MyDate
Dim Month
MyDate = Format(Date, "yyyymmdd")
Month = Format(Date, "mmmm")
ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\Users\me\filename.xlsm" _
, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, _
WritePasswordDocument:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\now\file_.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB" _
, SQLStatement:="SELECT * FROM `Merge_1$`", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
Set MainDoc = ActiveDocument
With MainDoc
StrFolder = "C:\Users\me\" & Month & "\"
With .MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
On Error Resume Next
For i = 1 To .DataSource.RecordCount
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
If Trim(.DataFields("ID")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & "\"
StrName = MyDate & " - " & .DataFields("File_Name")
End With
.Execute Pause:=False
If Err.Number = 5631 Then
Err.Clear
GoTo NextRecord
End If
For j = 1 To Len(StrNoChr)
StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = Trim(StrName)
With ActiveDocument
'.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
' and/or:
.SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=True
.Close SaveChanges:=False
End With
NextRecord:
Next i
End With
End With
Application.ScreenUpdating = True
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
VBA Code:
Sub MailMerge()
'Get user who is completing document
Dim User As String
User = Sheets("Merge_1").Range("AC1").Value
'Run Mailmerge for Sheet1
Dim wdc
Dim xc
Set wdc = CreateObject("word.application")
wdc.Application.documents.Open "C:\Users\me\" & User & "\Template1.docm"
wdc.Application.Visible = False
wdc.Application.Run "Mail_Merge21"
Set wdc = Nothing
end sub
Edit - Sorry for the title, didn't know X was a curse!..