Start MailMerge for 3 different Word documents in Excel depending on value in column A

[Kalü]

Hi guys



I am trying to make a button in my excel-sheet that simply starts a MailMerge in word (for that my colleagues can use my work, too).

Depending on the value in row A it has to open 3 different word docs and do the mail merge:
- if value in A = 1 then doe the mailmerge for "sb1.docx"
- if value in A = 2 then doe the mailmerge for "sb2.docx"
- if value in A = 3 then doe the mailmerge for "sb3.docx"

Because we need single word docs for every entry in excel, I already use a macro, when i open the word docs and start mail merge manually (sadly my colleagues dont have enough knowhow to do that, thats why I try to create the button in excel):

Sub aaaaSerienbrief()
    ' set variables
    Dim iBrief As Integer, sBrief As String
    Dim AppShell As Object
    Dim BrowseDir As Variant
    Dim Path As String
    
    ' catch any errors
    On Error GoTo ErrorHandling
    
    ' determine path
    Set AppShell = CreateObject("Shell.Application")
    Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, 16) _
 _
 _
 _

    
    If BrowseDir = "Desktop" Then
        Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    Else
        Path = BrowseDir.items().Item().Path
    End If
    
    If Path = "" Then GoTo ErrorHandling
        
    Path = Path & "\Serienbrief-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "\"
    MkDir Path
    
    On Error GoTo ErrorHandling
        
    ' hide application for better performance
    MsgBox "Serienbriefe werden exportiert. Dieser Vorganag kann einige Minuten dauern -  _
Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
    Application.Visible = False
 
    ' create bulkletter and export as docx
    With ActiveDocument.MailMerge
        .DataSource.ActiveRecord = 1
        Do
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = .ActiveRecord
                .LastRecord = .ActiveRecord
                sBrief = Path & .DataFields("ID").Value & ".docx"
            End With
            .Execute Pause:=False
        
            If .DataSource.DataFields("ID").Value > "" Then
                ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatdocx
            End If
            ActiveDocument.Close False
        
            If .DataSource.ActiveRecord < .DataSource.RecordCount Then
                .DataSource.ActiveRecord = wdNextRecord
            Else
                Exit Do
            End If
        Loop
    End With
    
    ' error handling
ErrorHandling:
    Application.Visible = True
 
    If Err.Number = 76 Then
        MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
    ElseIf Err.Number = 5852 Then
        MsgBox "Das Dokument ist kein Serienbrief"
    ElseIf Err.Number = 4198 Then
        MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
    ElseIf Err.Number = 91 Then
        MsgBox "Exportieren von Serienbriefen abgebrochen", vbOKOnly + vbExclamation
    ElseIf Err.Number > 0 Then
        MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.",  _
vbOKOnly + vbCritical
    Else
        MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
    End If
End Sub

Can I somehow integrate this word-vba-code into excel and make a button that automatically merges all entries into the right word docs?