Discussion :

[nonesofar]

Bonjour le forum,

J'ai une macro qui va récupérer les noms de fichiers dans un dossier, les noms des fichiers vont servir à remplir le champ destinataire de outlook.

Je suis arrivé à mon objectif mais je suis obligé de noter les noms sur la feuille excel et aprés boucler sur les cellules contenant les noms des fichiers pour remplir le champs destinataire d'un email outlook.

Ce que je souhaite c'est sauter l’étape écriture des adresses sur la feuille et passer directement par des variables.

Voici le code.

Après je sais pas si cela est possible mais ça serait une solution bien élégante pour rendre efficace ma macro

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
 
Sub ecriture_destinataire_surfeuille()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
 
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Tampon\")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    Cells(i + 1, 1) = Left(objFile.Name, 9)
    i = i + 1
Next objFile
End Sub
 
'------------------------------------------------------------------------------------------------------------------------------------------------
 
Sub remplir_destinataire
 
'on va écrire sur la feuil1 en A2:A10 les noms des fichiers qui vont servir de destinataire outlook'
Call ecriture_destinataire_surfeuille
 
    Set emailRng = Worksheets("Feuil1").Range("A2:A10")
 
    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value
    Next
 
 
    With MailOutLook
        .BodyFormat = olFormatRichText
        .To = sTo 'je souhaite que les valeurs des destinataires soient directement en variable et non pas ecrit dans une range sur la feuil1'
 
		'etc..'
 
end sub

[Nodens_swiss]

Hello
Tu peux passer par un tableau.
http://silkyroad.developpez.com/vba/tableaux/

C'est le plus proper.

[nonesofar]

Salut Nodens_swiss,

Merci de ton aide c'est vrai que j'utilise pas trop les tableaux en vba, vais regarder ça.

[Nodens_swiss]

Quand tu auras commencé, tu ne pourras plus t’en passer.
N’oublie pas de mettre ton tableau en « public » si tu veux l’utiliser dans plusieurs macro.

[nonesofar]

Ben c'est plus facile que ce que je pensais avec les tableaux . Merci de m'avoir poussé sur cette solution.

Voila le code final.

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
62
63
64
65
66
67
68
69
70
71
 
Public a(1 To 10) 'tableau 1 dimension
 
Sub multiple_file()
    Dim mess_body As String, StrFile As String, StrPath As String
    Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
 
 
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
 
    '~~> Change path here
    StrPath = "C:\Tampon\"
 
    'nom des fichiers comme destinataire dans le tableau a
    Call Example1
 
    'boucle sur le tableau a de 1 colonne de 10 lignes
    For i = 1 To 10
        sTo = sTo & ";" & a(i)
    Next i
 
 
    With MailOutLook
        .BodyFormat = olFormatRichText
        .To = sTo
        .Subject = "Rapport d'appels du mois d'"
        .HTMLBody = "Bonjour, " & _
                    vbCrLf & vbCrLf & _
                    "Ci-joint le fichiers des appels du mois passé pour votre agence." & _
                    vbCrLf & vbCrLf & _
                    "Nous restons bien entendu à votre disposition pour tout renseignement complémentaire." & _
                    vbCrLf & vbCrLf & _
                    "Cordialement." & _
                    vbCrLf & vbCrLf
 
        '~~> *.* for all files
        StrFile = Dir(StrPath & "*.*")
 
        Do While Len(StrFile) > 0
            .Attachments.Add StrPath & StrFile
            StrFile = Dir
        Loop
 
        '.DeleteAfterSubmit = True
        .Display
    End With
 
    MsgBox "Les rapports sont envoyés correctement", vbOKOnly
End Sub
 
Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
 
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Tampon\")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
    'print file name
    a(i) = Left(objFile.Name, 9)
    i = i + 1
Next objFile
 
End Sub

[AlainTech]

Bonjour,

Même si j'arrive après la bataille, tu peux remplacer ceci:

Code :

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

1
2
3
    For i = 1 To 10
        sTo = sTo & ";" & a(i)
    Next i

par:

Code :

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

  sTo = Join(a, ";")

C'est plus propre, plus rapide et n'ajoute pas un ";" parasite en début de chaine.

[nonesofar]

Hello AlainTech,

Merci pour ce petit conseil , en effet je ne maîtrise pas encore trop ce genre subtilité ça me fait plaisir d'apprendre un nouveau truc.

@+