Envoi automatisé de fichiers sous Outlook 2003

[hesiode23]

Bonjour à tous les forumeurs/euses,
Cela fait maintenant 1 an que je lis et que je progresse sur Excel grâce à ED, et j'ai toujours trouvé les réponses à mes questions dans des fils déjà crée.
Mais je bloque sur un problème depuis maintenant 2 semaines et je ne trouve pas de réponses malgré une recherche assidue.

Nous y voilà :
J'ai un fichier nommé "final" dans lequel j'ai un questionnaire (feuil "Form"), les réponses du futur répondant (feuil "Answ"), la feuille des "paramètres" (du même nom) et la feuille qui contiendra tous les noms et adresses de mes destinataires ("mails").

Je duplique le fichier "final", je l'enregistre au nom pioché dans la feuil "mails" du fichier "final" puis je supprime la feuill "mails" (du fichier nouvellement crée) : une fois cela fait, je souhaite que le fichier nouvellement crée soit inséré en pièce jointe d'un mail que j'enverrai à l'adresse mail correspondante à chacun de mes destinataires (eux mêmes toujours contenu dans la feuill "mails" de mon fichier "final", mais vous aviez compris!!! ). L'application sollicitée pour l'envoi des mails est Outlook 2003.

Or, tout marche comme sur des roulettes jusqu'à l'envoi de mon mail : en effet, j'ai utilisé la méthode sendkey pour simuler les touches, mais je l'ai fait initialement pour Outlook Express. Or, même en adaptant mes sendkey, cela ne fonctionne pas sur Outlook 2003:
1/ l'import du fichier texte (nommé "Corpsmail.txt") ne fonctionne pas (au lieu de cela, il vient en pj)
2/ le mail n'est pas envoyé
3/ le mail n'est pas rempli



Voiçi le code en entier (je vous laisse mes commentaires):

Sub QuestGx()
Suppr
GenerationQuestionnairesGeneraux
SendEmail
End Sub

Sub CopierEtEnvoyer()

Dim classeurActuel As Workbook
Dim nouveauClasseur As Workbook
Dim nomNouveauClasseur$
Dim repertoireSauv$ 'represente le chemin dans lequel je veux sauvegarder tes fichiers excel

'infos recuperees dans la feuille "mails"
Dim matricule$
Dim nomPers$
Dim mail$


Dim ligne As Integer 'numero de la ligne en cours de traitement
Dim nb As Integer 'nombre de fichiers traites

Dim feuilleASupprimer$ 'nom de l'onglet a supprimer dans les nouveaux classeurs


repertoireSauv = "D:\Documents and Settings\S592058\Desktop\Questionnaires généraux par destinataire"
'on teste ici si le dossier se termine par \ (sinon ca plante) si ce n'est pas le cas je le rajoute
If Strings.Right(repertoireSauv, 1) <> "\" Then
repertoireSauv = repertoireSauv & "\"
End If

Application.ScreenUpdating = False

On Error Resume Next
ChDir (repertoireSauv)
If Err <> 0 Then
MsgBox "Le repertoire " & repertoireSauv & " n'existe pas, il sera crée."
FileSystem.MkDir (repertoireSauv)
End If


' on initialise les variables
feuilleASupprimer = "mails"
ligne = 2
nb = 0

Sheets(feuilleASupprimer).Select

While ActiveSheet.Cells(ligne, 1) <> ""
matricule = ActiveWorkbook.ActiveSheet.Cells(ligne, 1)
nomPers = ActiveWorkbook.ActiveSheet.Cells(ligne, 2)
mail = ActiveWorkbook.ActiveSheet.Cells(ligne, 3)

nomNouveauClasseur = repertoireSauv & matricule & "_" & Strings.Replace(nomPers, " ", "") & ".xls"

Set classeurActuel = ThisWorkbook
classeurActuel.SaveCopyAs (nomNouveauClasseur)
Set nouveauClasseur = Workbooks.Open(nomNouveauClasseur)

For i = 1 To nouveauClasseur.Sheets.Count
If nouveauClasseur.Sheets(i).Name = feuilleASupprimer Then
'MsgBox "on supprime la feuile '" & nouveauClasseur.Sheets(i).Name & "' dans le classeur " & nomNouveauClasseur
Application.DisplayAlerts = False
nouveauClasseur.Sheets(i).Delete
GoTo Sauvegarde
Application.DisplayAlerts = False
End If
Next

Sauvegarde:

nouveauClasseur.Save
nouveauClasseur.Close True

' MsgBox "on envoie a " & mail & " le classeur " & nomNouveauClasseur
ligne = ligne + 1
nb = nb + 1

Wend

Application.ScreenUpdating = True

MsgBox "Traitement terminé : " & nb & " fichiers envoyés."

End Sub

Function SendEmail()
Dim Subj, repertoireSauv$, EmailAddr, Corps, HLink As String

i = 2
k = 2

While Not Feuil1.Cells(i, 1).Value = ""
While Feuil1.Cells(k + 1, 1).Value = Feuil1.Cells(i, 1).Value
k = k + 1
Wend

'-------------------------------------------------définir les données
Subj = "De la part d'XXXXXXXX : audit 2008"

EmailAddr = Feuil1.Cells(i, 3).Value

Corps = ThisWorkbook.Path & "\CorpsMail.txt"

'--------------------------------------------------Construire lien hypertexte
HLink = "mailto:" & EmailAddr & "?"
HLink = HLink & "subject=" & Subj

'--------------------------------------------------Transmettre le message
ActiveWorkbook.FollowHyperlink HLink

Emplacement2 = ThisWorkbook.Path & "\Questionnaires généraux par destinataire\" & Feuil1.Cells(i, 2).Value & ".xls"
Application.Wait (Now + TimeValue("0:00:01"))

SendKeys "%i", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "f", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys Emplacement2, True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{enter}", True

'ATTENTION : le nombre de {Tab} dépend de la présence ou non de la ligne d'adresse Cci (copies cachées)
SendKeys "{Tab}{Tab}{Tab}{Tab}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%i", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "f", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys Corps, True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{enter}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "^{s}", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%{F4}", True
i = k + 1
k = k + 1


Wend
End Function




Je sais qu’Outlook 2003 me demandera à chaque fois l'autorisation d'envoyer, mais ce n'est pas grave si chacun des mails est bien généré automatiquement.

Si il y avait une âme charitable dans la communauté d'experts d'ED pour m'aider, je vous en serai fort reconnaissant..

1000 mercis d'avance à vous, j'en peux plus de cette macro...

Hesiode23

 

[Roland_M]

Re : Envoi automatisé de fichiers sous Outlook 2003

bonsoir

tu peux aussi envoyer directement tes messages sans l'intermédiaire d'Outlook !
à savoir qu'il faut être connecté !

exemple à compléter pour ce qui est des variables:

'################################### envoi messagerie directement ###############################
'Ajouter la référence "Microsoft CDO for..." Probablement: Microsoft CDO for Windows 2000 Library
Public Sub EnvoiMailCDO()
On Error Resume Next
Dim cMail As New CDO.Message
If Err Then
   M$ = "CDO n'est pas installé !" & vbLf & _
   "Vous devez cocher(du côté VB) la référence suivante:" & vbLf & _
   "Microsoft CDO for..." & vbLf & _
   "probablement: Microsoft CDO for Windows 2000 Library"
   MsgBox M$, vbCritical, "Erreur référence"
   On Error GoTo 0: Err.Clear
   Exit Sub
End If
'INITIALISATION des variables
Application.ScreenUpdating = False
Dim CheminFichier As String
Dim Subject As String, Message As String
Dim AdresExpediteur As String, AdresDestinataire As String
'
CheminFichier = "????????????????" '<<<
AdresExpediteur = "??????????????" '<<<
AdresDestinataire = "????????????" '<<<
Sujet = "????????????????????????" '<<<
Message = "??????????????????????" '<<<
'envoi directement NET messagerie
On Error GoTo ErreurNET
With cMail
 .From = AdresExpediteur '<<<<<<<<<<<<<
 .To = AdresDestinataire '<<<<<<<<<<<<<
 .Subject = Sujet '<<<<<<<<<<<<<<<<<<<<
 .TextBody = Message '<<<<<<<<<<<<<<<<<
 .AddAttachment (CheminFichier) '<<<<<<
 .Send
End With
'
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
Exit Sub
'---------------------------------------------------
ErreurNET:
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number
Msg$ = Msg$ & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
End Sub

Roland

 

[BERRACHED said]

Re : Envoi automatisé de fichiers sous Outlook 2003

Salut,Hésiode23,RolandM


en cherchant dans mon grenier j'ai pu dénicher une Démo de Thierry j'espere qu'elle fera votre affaire

Cordialement

 

[MuscatMimi]

Re : Envoi automatisé de fichiers sous Outlook 2003

Salut Berracheid ,un bonjour de la Provence
et bonjour au Forum

Je squate ce fil, milles excuses
Mais ce Fichier mail, m'a donnée une idée pour la continuité du Classeur Gestion Stock de notre ami Thiérry dont tu m'a déja bien aidé a ce sujet
Dis-moi, a t'on possibilité de mettre une ComboBox a la place de la TextBox pour choisir une adresse mail parmis une Liste????,
Bon WE Berracheid

 

[Roland_M]

Re : Envoi automatisé de fichiers sous Outlook 2003

bonjour

bien entendu que l'on peut c'est effectivement plus simple pour les saisies
il suffit de mettre les adresses dans une colonne que tu nommes exp:RangAdresses
de remplacer le textbox par un ComboBox
et de l'initialiser comme ceci:

Private Sub UserForm_Initialize()
ComboBox1.RowSource = "RangAdresses"
End Sub

après cela il faut revoir le code de l'userform concernant Textbox


Roland

 

[MikeBelgique]

Re : Envoi automatisé de fichiers sous Outlook 2003

Salut hesiode23, voici un exemple adapté à mon besoin pour l'envoi d'une feuille spécifique tiré de usf mail send mail à l'époque de mon premier projet, cela pourrait peut etre t'inspirer
a+

 

[tonton29610]

Re : Envoi automatisé de fichiers sous Outlook 2003

Bonjour,
J'avais un problème du même genre que le tient, j'ai trouver la solution sur ce forum grace à ce lien:
Sending mail from Excel with CDO
Bon courage.

 

[MuscatMimi]

Re : Envoi automatisé de fichiers sous Outlook 2003

salut Tonton,Roland ,Mike, et au forum
Merci a tous, finalement j'ai suivi mon idée ComboBox
donc j'ai pris le code de Roland
Merci

 

[BERRACHED said]

Re : Envoi automatisé de fichiers sous Outlook 2003

Salut,Vaucluse,le Forum

j'ai été occupé je viens juste de m'en apercevoir que tu m'a solliciter pour l'idée du combox hé ben t'a été servi tant mieux merci aux autres tu vois que c'est un forum extraordinaire

excellent week end

Cordialement

 

[mcj1997]

Re : Envoi automatisé de fichiers sous Outlook 2003

Bonjour,

Votre programme m'interésse, pourriez vous le mettre en ligne avec le combobox suite message de roland.

Merci d'avance,

 

[MuscatMimi]

Re : Envoi automatisé de fichiers sous Outlook 2003

Bonjour Berracheid ,MJC et au forum

Oui, Berracheid, ce forum est vraiment trés bien,
Il y a des trés bons comme toi, et bien d'autres , et des débutant dont je fais partie
Oui j'ai eu pas mal de réponse
Pour les codes VBa ASCII, j'ai fais le post et juste aprés j'ai pensé que je pouvais en cas de besoin les récupérer, dans Caractéres Spéciaux, la en bas de la féêtre il y a les Codes Vba de noté
Mais merci quand même de ta Macro pour en extraire la liste

Pour MJC, c'est a vaucluse que tu t'adresse ou a Berracheid???,,
Cordialement
Merci encore une fois a tous

 

[mcj1997]

Re : Envoi automatisé de fichiers sous Outlook 2003

Bonjour,

A l'origine c'était à Vaucluse qui était très prêt de faire ce que je recherche aussi.

Merci d'avance,

 

[MuscatMimi]

Re : Envoi automatisé de fichiers sous Outlook 2003

que désire tu comme fichier?? ou codes Vba

 

[mcj1997]

Re : Envoi automatisé de fichiers sous Outlook 2003

Je souhaite les codes vba

 

[MuscatMimi]

Re : Envoi automatisé de fichiers sous Outlook 2003

voila le fichier pour expédier les mails