Microsoft 365 Macro excel spécifier chemin de sauvegarde one drive

Function ChoixDossier()
    
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
    
     Else
       ChoixDossier = InputBox("Répertoire?")
    
     End If
     MsgBox ChoixDossier

End Function


Sub publipostage()
    
    Dim j As String
    Dim docWord As Object ' Word.Document
    Set docWord = CreateObject("Word.Document")
    Dim appWord As Object 'Word.Application
    Set appWord = CreateObject("Word.Application")
    Dim NomBase As String
    fic_doc As String
    cheminW As String
    fichier_source As String
    DocName As String
    Dim nom_fichier As String
    Nomsourcebase As String
    message_boite As String
    Dim fin As Integer
    i As Integer


    Dim wdSendToNewDocument, wdExportFormatPDF, wdExportOptimizeForPrint, wdExportAllDocumnt, wdExportCreateHeadingBookmarksent, wdExportDocumentConte
    wdSendToNewDocument = 0
    wdExportFormatPDF = 17
    wdExportOptimizeForPrint = 0
    wdExportAllDocument = 0
    wdExportDocumentContent = 0
    wdExportCreateHeadingBookmarks = 1
 
    j = ActiveSheet.Name
'Choisir la source de donnees   
message_boite = "Fichier Source tableau excel"
Nomsourcebase = Application.GetOpenFilename("Fichiers Excel (*.xlsm), *.xlsm", , message_boite)
If Nomsourcebase = False Then Exit Sub

'Choisir le document word
message_boite = "Fichier source word "
fic_doc = Application.GetOpenFilename("Fichiers Word (*.docx), *.docx", , message_boite)
If fic_doc = False Then Exit Sub


' Selectionner le chemin de sauvegarde     
message_boite = "Dossier destiantion "
cheminW = ChoixDossier


Application.ScreenUpdating = False

fichier_source = ActiveWorkbook.Name

    Set appWord = CreateObject("Word.Application") 'Word.Application
    appWord.Visible = True

    'Ouverture du document principal Word
    Set docWord = appWord.documents.Open(fic_doc)
       With docWord.MailMerge
        'Ouvre la base de données
        .OpenDataSource Name:=Nomsourcebase, Connection:="Driver={Microsoft Excel Driver (*.xlsx)};" & "DBQ=" & Nomsourcebase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Base$]"
                fin = .DataSource.RecordCount
        End With

For i = 1 To fin
    
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.MailMerge
        
        .destination = wdSendToNewDocument
        .SuppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
            End With
            
        'Exécute l'opération de publipostage
        .Execute Pause:=False
        
        .DataSource.ActiveRecord = i 'execute le publipostage
        DocName = "Attestation fiscale " & .DataSource.DataFields(3).Value
        DocName = DocName & " " & .DataSource.DataFields(4).Value
        DocName = DocName & " pour " & .DataSource.DataFields(9).Value

    End With
    
    nom_fichier = DocName & ".pdf"
    Sheets("Base").Select
    Cells(i + 1, 11).Select
    Selection.Value = nom_fichier
    
    With appWord.ActiveDocument
        .ExportAsFixedFormat OutputFileName:=(nom_fichier), _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
        .SaveAs cheminW
        .Close False
    
    End With
Next i
    Sheets(j).Select
    Application.ScreenUpdating = True
    MsgBox ("Les attestations ont été généré dans le dossier")
    
    'Fermeture du document Word
    docWord.Close False
    appWord.Quit


    
End Sub