1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
|
Sub publipostage(nomPublipostage As String, nomTable As String)
NOM_FEUILLE_EXCEL = "\" & ThisWorkbook.Name
Dim MonWord As Object
Dim Publipostage1
Set MonWord = CreateObject("Word.Application")
'MonWord.Visible = True
MonWord.DisplayAlerts = wdAlertsNone
Set Publipostage1 = MonWord.Documents.Open(Filename:=CHEMIN & nomPublipostage, ConfirmConversions:=True, _
ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", XMLTransform:="")
On Error GoTo Test
Publipostage1.MailMerge.OpenDataSource Name:= _
CHEMIN & NOM_FEUILLE_EXCEL, _
ConfirmConversions:=True, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & CHEMIN & _
NOM_FEUILLE_EXCEL & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet ", _
SQLStatement:="SELECT * FROM " & nomTable, SQLStatement1:=""
With Publipostage1.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.Execute Pause:=False
End With
Publipostage1.Close False
MonWord.DisplayAlerts = wdAlertsAll
MonWord.Visible = True
Set Publipostage1 = Nothing
Test:
If Err.Number = 9105 Then
Publipostage1.Close True
MsgBox MSG_BOX_PUBLI
End If
End Sub |
Partager