Discussion :

[Izno1978]

bonjour

j'ai un répertoire avec des fichiers et un feuille excel avec une liste de nom et leur adresse email

je veux envoyer un fichier précis à une adresse email précis grâce au nom

pour le premier envoi pas de problème le fichier de A part bien vers A
mais pour les autres il rajoute les fichiers qu'il a déjà envoyé

exemple si R est en second il envoyé le fichier de A + fichier de R vers R

j'arrive pas à voir d’où vient le problème

merci

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
Sub Nom_fichier()
 
Dim Fic As String
Dim nomFichier As String
Dim RIB As String
Dim RIB2 As String
Dim FichierEnvoye As String
 
On Error Resume Next
 With CreateObject("CDO.Message")
  If Err Then
   MsgBox "CDO non installé"
 Else
 
Fic = InputBox("Entrez le chemin complet du dossier contenant les fichiers", "Fichiers à envoyer")
 
nomFichier = Dir(Fic & "\*.xls")
 
While nomFichier <> ""
 
  For K = 1 To Worksheets("Feuil2").Range("A65536").End(xlUp).Row
   RIB = Worksheets("Feuil2").Cells(K, 1)
   RIB2 = RIB & ".xls"
 
  If RIB2 = nomFichier Then
  FichierEnvoye = Fic & "\" & nomFichier
 
 .From = "AA@AAAA.FR"
 .To = Worksheets("Feuil2").Cells(i, 2)
 .Subject = Worksheets("Feuil2").Cells(i, 1)
 .HTMLBody = "Test"
 .AddAttachment (FichierEnvoye)
 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = X
 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "XXXX"
 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = XX
 .Configuration.Fields.Update
On Error Resume Next
 .Send
 
  End If
  Next K
 
nomFichier = Dir
i = i + 1
Wend
 
 End If
 
On Error GoTo 0
 
End With
 
End Sub

[l_autodidacte]

D'après le code tu es entrain d'utiliser soit VB6 soit VBA(à cause du typage des variables en plus La fonction Dir n'est pas disponible en VBScript).

[Izno1978]

oui c'est du vba , comment je peux déplacer ma discussion dans le bon forum?

[Oliv-]

Bonjour,

On peut faire autrement:

Si j'ai bien compris tu as un fichier excel et tu parcours les lignes pour envoyer le fichier RIB correpondant à un destinataire ?

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
Sub Nom_fichier()
 
Dim Fic As String
Dim nomFichier As String
Dim RIB As String
Dim RIB2 As String
Dim FichierEnvoye As String
 
On Error Resume Next
 With CreateObject("CDO.Message")
  If Err Then
   MsgBox "CDO non installé"
 Else
 
Fic = InputBox("Entrez le chemin complet du dossier contenant les fichiers", "Fichiers à envoyer")
 
  For K = 1 To Worksheets("Feuil2").Range("A65536").End(xlUp).Row
   RIB = Worksheets("Feuil2").Cells(K, 1)
   RIB2 = RIB & ".xls"
 
 FichierEnvoye = Fic & "\" & RIB2 
  If len(dir(FichierEnvoye) >0 Then
 
 .From = "AA@AAAA.FR"
 .To = Worksheets("Feuil2").Cells(i, 2)
 .Subject = Worksheets("Feuil2").Cells(i, 1)
 .HTMLBody = "Test"
 .AddAttachment (FichierEnvoye)
 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = X
 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "XXXX"
 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = XX
 .Configuration.Fields.Update
On Error Resume Next
 .Send
 
  End If
  Next K
 
i = i + 1
 
 End If
 
On Error GoTo 0
 
End With
 
End Sub

[Izno1978]

marche pas

Alors j'ai un classeur exel regroupant dans la colonne A les rib et la colonne B les email des destinataires
dans un dossier j'ai X fichiers où leur nom correspond est le rib

le but c'est d'envoyer le fichier BSD à BSD@XX , fichier ERD à ERD@XX, ect

actuellement avec le code cela me fait BSD est envoyé à BSD , ERD reçoit les fichiers ERD+BSD, ect ect le suivant a qui on lui envoi l'email reçoit tous les fichiers précedents déjà envoyer à d'autres alors que je ne veux qu'il ne reçoivent que son fichier à lui.


le probleme viendrait de attachments son count augmente a chaque envoie comment el remettre à zero ?

[Oliv-]

et avec ça :

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
Sub Nom_fichier()
 
    Dim Fic As String
    Dim nomFichier As String
    Dim RIB As String
    Dim RIB2 As String
    Dim FichierEnvoye As String
    Dim Cdo_Message As Object
 
 
 
 
    Fic = InputBox("Entrez le chemin complet du dossier contenant les fichiers", "Fichiers à envoyer")
 
    For k = 1 To Worksheets("Feuil2").Range("A65536").End(xlUp).Row
        RIB = Worksheets("Feuil2").Cells(k, 1).Value
        RIB2 = RIB & ".xls"
 
        If Not Right(Fic, 1) = "\" Then Fic = Fic & "\"
        FichierEnvoye = Fic & RIB2
        If Len(Dir(FichierEnvoye)) > 0 Then
            On Error Resume Next
            Set Cdo_Message = CreateObject("CDO.Message")
            On Error Resume Next
            If Err Then
                MsgBox "CDO non installé"
                Exit Sub
            Else
                With Cdo_Message
                    .From = "octu@grassavoye.com"
                    .To = Worksheets("Feuil2").Cells(k, 2)
                    .Subject = Worksheets("Feuil2").Cells(k, 1)
                    .HTMLBody = "Test"
                    .AddAttachment (FichierEnvoye)
                    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.xxxx.com"
                    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                    .Configuration.Fields.Update
                    On Error Resume Next
                    .Send
                    If Err <> 0 Then
                        MsgBox Err.Number & Err.Description & Err.LastDllError
 
                        Err.Clear
                    End If
                End With
            End If
 
        End If
    Next k
 
    On Error GoTo 0
 
 
End Sub

[Izno1978]

je crois que c'est bon je vais faire qqtest et je reviendrai informé si c'est résolu

merci beaucoup