Discussion :

[graphikris]

Bonjour,

Après des heures de recherches sur le net, je viens de trouver un fichier Excel composé de 3 onglets et d'un module dont le code est le suivant :

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
Option Explicit
 
Sub envoi_Feuille()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
 On Error Resume Next
            '-------Contrôler dans Bisual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
Dim adresse(1 To 10)
            '----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 10
Set malist = Sheets("Feuil1").Range("A2:A10")
Count = 1
For Each Envoi In malist
If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
Next
            '----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
[H1] = Array(adresse(1) & "; " & adresse(2) & "; " & _
adresse(3) & "; " & adresse(4) & "; " & adresse(5) & "; " & adresse(6), adresse(7), adresse(8), adresse(9), adresse(10))
            '-------adresse du répertoire ou sera enregistré le fichier
AdresseRépertoire = ActiveWorkbook.Path
            '---------------------copie de la feuille à envoyer
Application.DisplayAlerts = False
Sheets("Feuil2").Copy
            '---------------------Nom du fichier à envoyer
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule  Range("E2").Value & ".xls"
ActiveWindow.Close
            '---------------------Envoi par mail
Sheets("Feuil1").Select
Range("H1").Select
            '---------------------contrôle la validité ou la présence d'adresse mail en H1
If [H1] Like "*@*" Then
            '---------------------Le mail est envoyé que si y a des adresses feuille 1 en H1
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails
            '--------------------Saisir le sujet de l'envoi
msg.Subject = "Coucou c'est moi "  ' ou saisir le sujet dans une cellule ex. Range("H2").Value
            '---------------------saisie du message
msg.Body = "Bonjour" & Chr(13) & Chr(13) & "Veuillez trouver ci-joint" & Chr(13) & "copie du dossier" & Chr(13) & Chr(13) & "Cordialement"
            '---------------------ou saisir le message dans des cellules
'msg.Body = Range("E5").Value & Chr(13) & Chr(13) & Range("E8").Value & Chr(13) & Chr(13)& Range("E10").Value
            '---------------------ou saisir le message dans des cellules
            '---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:=AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule  Range("E2").Value & ".xls"
msg.Send
            '---------------------effacement de la liste d'envoi
[H1].ClearContents
Loop
Else
MsgBox "Aucune adresse valide sélectionnée"
End If
Application.ScreenUpdating = True
End Sub

Aucune complication pour comprendre ce code, la macro fonctionne correctement mais mon souci est le suivant :

Lorsque je veux intégrer ces 3 feuilles ainsi que le code dans un autre fichier Excel (ma base de données composée de 15 feuilles renommées autrement que Feuil1, Feuil2, ...., Feuil15) çà bug dans le code.

Si je renomme également les 3 feuilles du présent classeur (fichier joint) et que je modifie également le nom des feuilles dans le code Vba, çà bug aussi.

Sinon La feuille 3 a-t-elle une importance primordiale vu qu'elle n'est pas utilisée dans le code ?

Quelqu'un aurait il une solution à me proposer pour résoudre ce bug ?

Cordialement.

[Daniel.C]

Bonjour,

Ca bugue ? sur quelle ligne ? quel est le message d'erreur ?

[graphikris]

Dès que je clique sur le bouton "Envoi Mail" qui déclenche la macro : envoi_Feuille(), çà bugue sur la ligne 2 :

Code :

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

1
2
Sub envoi_Feuille()
Dim olapp As Outlook.Application

avec le msg d'erreur suivant :

Erreur de compilation : Type défini par l'utilisateur non défini.

Lorsque je contrôle dans Visual Basic/Outils/Références/, Object Librairy est bien coché (j'ai fait une copie écran).

çà ne fait celà uniquement lorsque je copie le module ainsi que les 3 feuilles dans mon fichier (base de données.xls).
Si j'utilise le fichier joint au 1er msg, là tout fonctionne.

[Daniel.C]

Tu dois cocher la référence "Microsoft Outlook 11.0 Object Library".

[graphikris]

Merci et bon W.E

[graphikris]

Re,

J'ai deux autres soucis dans le code à cet endroit :

Code :

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

1
2
3
4
'---------------------Nom du fichier à envoyer
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & "Class.xls"
 ' ou adresse si le nom est dans une cellule  Range("E2").Value & ".xls"
ActiveWindow.Close

et celui -ci :

Code :

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

1
2
3
'---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:=AdresseRépertoire & "\" & "Class.xls"
 ' ou adresse si le nom est dans une cellule  Range("E2").Value & ".xls"

Comment dois je procéder si je mets en E2 (déjà de quelle feuille ?) le nom du fichier à envoyer ?

J'ai mis ceci mais çà ne fonctionne pas :

1er code :

Code :

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

1
2
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & Range("E2").Value & ".xls"
ActiveWindow.Close

2eme code :

Code :

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

1
2
'---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:=AdresseRépertoire & "\" & Range("E2").Value & ".xls"

2eme incompréhension : j'ai modifié le code pour que je puisse envoyer jusquà 150 adresses comme ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
Dim adresse(1 To 150)
            '----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 151
Set malist = Sheets("Envoi Mail").Range("A2:A151")
Count = 1
For Each Envoi In malist
If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
Next
            '----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
[H1] = Array(adresse(1) & "; " & adresse(2) & "; " & _
adresse(3) & "; " & adresse(4) & "; " & adresse(5) & "; " & adresse(6), adresse(7), adresse(8), adresse(9), adresse(10))

Bien que après , adresse(10)), je n'ai pas continué jusqu'à adresse(150)),
celà fonctionne est ce normal ?


Merci