Microsoft Office Forums - View Single Post

macropod · 09-25-2018, 06:01 PM

There is nothing about your code that would generate an error in the CSV file or in Word's processing of that for a mailmerge. That said, without seeing the CSV file your system produces, I can't comment on that.

Some comments on your code:

Do you realise that, with:
Dim i, j, k, l, m, n, o, p, q, r, s, t, u As Double
only u is a Double - all the rest are Variant. In any event, your usage suggests those that are actually being used should be declared as Long, not as Double. The rest should be omitted as they just add clutter.

All this:

Code:

    Sheets("MergePreFinal").Select
    Sheets("MergePreFinal").Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:2").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp

could be reduced to:

Code:

    With Sheets("MergePreFinal")
      .UsedRange.Value = .UsedRange.Value
      .Rows("1:2").Delete
    End With

Your code also has a lot more circumlocution, too; it seems to me it could all be reduced to:

Code:

Public Sub Automatisation()

'Dimension des variables
Dim i As Long, nomfichier As String

'Automatisation des bases
'On copy paste les lignes du document source concernant les Options et Base seulement dans un fichier Excel se nommant Base

    With Sheets("MergePreFinal")
        .UsedRange.Value = .UsedRange.Value
        .Rows("1:2").Delete
        'Espace entre Vie et Vie Pac
        i = 2
        Do
            If .Cells(i, .Range("FIN").Column) = "BASE" Then
                i = i + 1
            ElseIf .Cells(i, .Range("FIN").Column) = "OPTI" Then
                i = i + 1
            Else
                .Rows(i).EntireRow.Delete
            End If
        Loop Until .Cells(i, Range("FIN").Column) = "FIN"
        .Rows(i).EntireRow.Delete
    End With
    
'Must save in CSV because more than 255 mergefields!

    Application.DisplayAlerts = False
    nomfichier = "S:\Merge Excel Files\Base" & Format(Now(), "yyyymmddhhmmss") & ".csv"
    ActiveWorkbook.SaveAs Filename:=nomfichier, FileFormat:=xlCSV, CreateBackup:=False, _
        ConflictResolution:=xlLocalSessionChanges, AddToMRU:=False
    Application.DisplayAlerts = True

    Dim wdApp As New Word.Application, wdDoc As Word.Document
    
    With wdApp
        'Disable alerts to prevent an SQL prompt
        .DisplayAlerts = wdAlertsNone
        'Open the mailmerge main document
        Set wdDoc = .Documents.Open("S:\Master - Garanties et Options - UW - 019.docx")
        With wdDoc
            With .MailMerge
                'Define the mailmerge type
                .MainDocumentType = wdDirectory
                'Connect to the data source
                .OpenDataSource Name:=nomfichier, ReadOnly:=True, AddToRecentFiles:=False, _
                Revert:=False, Format:=wdOpenFormatAuto, Connection:="Data Source=" _
                & nomfichier & ";Mode=Read", SQLStatement:="SELECT * FROM 'Sheet1'"
                .SuppressBlankLines = True
                With .DataSource
                    .FirstRecord = wdDefaultFirstRecord
                    .LastRecord = wdDefaultLastRecord
                End With
                'Define the output
                .Destination = wdSendToNewDocument
                'Excecute the merge
                .Execute
                'Disconnect from the data source
                .MainDocumentType = wdNotAMergeDocument
            End With
            'Close the mailmerge main document
            .Close False
        End With
        'Restore the Word alerts
        .DisplayAlerts = wdAlertsAll
        'Display Word and the document
        .Visible = True
    End With
    
'le code ouvre un Word avec le sommaire des garanties!
End Sub