Codage VBA scindement lettre fusionnées

**frumholtzj** · 27/06/2014, 13h47

Bonjour,

Je débute en VBA et travaille sous Word 2003 en réseau.

Je suis actellement en train de rédiger un code afin de m'aider dans le scindement des lettres fusionnées. En effet, chaque destinataire se verra envoyer une lettre de 4 pages et le destinataire suivant les quatres pages suivantes etc... Mon but est donc de fusionner séparément chaque lettre de chaque destinataire dans un répertoire dynamique.

Voici une ébauche de mon code :

Sub lettrefusionsepares()
'
' testpublipost Macro
' Macro enregistrée le 27/06/2014 par jonathan.frumholtz
' Déclaration des variables
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim DocName As String
Dim oDS As MailMergeDataSource

Dim Repertoire As FileDialog

Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show

MsgBox Repertoire.SelectedItems(1)
Chemin = Repertoire.SelectedItems(1)

' Affectation des objets
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource

iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
For i = 1 To iR
With oDoc.MailMerge
'Définition du premier et dernier enregistrement
.DataSource.FirstRecord = i

.DataSource.LastRecord = i
' Envoi des données dans un nouveau document
.Destination = wdSendToNewDocument
' Exécution du publipostage
.Execute
' Actualisation de l'enregistrement pour la sauvegarde
.DataSource.ActiveRecord = i
'Utilisation de deux champs pour obtenir le nom du document
DocName = .DataSource.DataFields(1).Value
DocName = DocName & "-" & .DataSource.DataFields(2).Value
Debug.Print DocName; i
End With
' Sauvegarde du document publiposté
With ActiveDocument
.SaveAs Chemin & DocName & ".doc"
'.PrintOut
.Close
End With
Next i

End Sub

Cependant, j'ai ce message d'erreur qui apparait :
"Erreur d'execution 5487 Impossible de terminer l'enregistrement : erreur d'autorisation d'accès au fichier. (T:\...\nom choisi dans le répertoire)

Auriez vous des modifications à apporter à ce code ?

Cordialement

Merci d'avance

Joe

**frumholtzj** · 27/06/2014, 21h44

Bonsoir, voici le code balisé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub lettrefusionsepares()
 
 
' Déclaration des variables
 
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim DocName As String
Dim oDS As MailMergeDataSource
Dim Repertoire As FileDialog
 
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
 
MsgBox Repertoire.SelectedItems(1)
Chemin = Repertoire.SelectedItems(1)
 
' Affectation des objets
 
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource
 
iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
For i = 1 To iR
With oDoc.MailMerge
 
'Définition du premier et dernier enregistrement
 
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
 
' Envoi des données dans un nouveau document
 
.Destination = wdSendToNewDocument
 
' Exécution du publipostage
 
.Execute
 
' Actualisation de l'enregistrement pour la sauvegarde
 
.DataSource.ActiveRecord = i
 
'Utilisation de deux champs pour obtenir le nom du document
 
DocName = .DataSource.DataFields(1).Value
DocName = DocName & "-" & .DataSource.DataFields(2).Value
Debug.Print DocName; i
End With
 
' Sauvegarde du document publiposté
 
With ActiveDocument
.SaveAs Chemin & DocName & ".doc"
.Close
End With
Next i
 
End Sub