[VBA] Excel-Outlook -Demande Explication code (module de classe)

Staple1600

XLDnaute Barbatruc
Bonjour à tous --> [CODE VBA] Envoie emails à partir d'Excel en utilisant Outlook<--

Le code VBA complet étant long, je me permets d'indiquer juste sa source:
code VBA (source)

Question :
Pour personnaliser ce code, comment utiliser une plage de cellules
pour stocker les adresses mail des destinataires?

Extrait du code:
Code:
Sub TestSendMail()
'variables
    Set arlToAddresses = New ArrayList
    Set arlCcAddresses = New ArrayList
    'config
    strSubject = "test"
   [B] arlToAddresses.Add ("nomprenom@fai.fr")[/B]
Comment pouvoir écrire
arlToAddresses.Add Range("A1:A20)


Merci à tous ceux qui s'interesseront à la question.

PS: Si cela peut vous aider, voici un fichier exemple contenant le code cité plus haut
edition: nouvelle version avec la modification d'Hasco
Ce lien n'existe plus
 
Dernière édition:
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

bonsoir,

avec :

Code:
'method: add an item
Public Sub Add(objRange As Variant)
    Dim r As Range
    
    For Each r In objRange.Rows

        If r.Range("A1").Text <> "" Then
            'redimension container
            ReDim Preserve m_arrContainer(m_intNumberOfItems)
        
            'now add the item
            m_arrContainer(m_intNumberOfItems) = r.Range("A1").Text
            
            'increment internal counter
            m_intNumberOfItems = m_intNumberOfItems + 1
        End If
    
    Next
End Sub

Cela devrait convenir

bon travail
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Bonsoir Hasco

Merci pour ton aide


Quand je teste Oulook reste ouvert alors
que d'après le code VBA, il devrait se fermer non?

Extrait du code
Code:
'this bypasses the security mechanism so that a mail goes out immediately
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.AppActivate OMail
    WshShell.SendKeys ("%s") ' sends a CTRL-S as if the user himself typed it in the application

PS: j'ai édité mon premier message et ajouté une nouvelle version du fichier incluant les modifications d'Hasco.
 
Dernière édition:
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re Bonsoir,

J'ai oublié de préciser qu'il valait mieux appeler la fonction par

arlToAddresses.Add (ActiveSheet.Range("A6:A19"))

La reférence à la feuille est necessaire car elle n'existe pas en tant qu'objet dans le module de classe.

Pour ce qui est d'Outlook lui-même, je ne peux pas tester, je ne l'ai pas sur ma bécane.

bonne soirée à toi.
 
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re Re RE;)

je viens de regarder plus attentivement la procédur :qsys_SendMailWithOutlook du module qsys

En fin de procédure, avant la ligne Set OApp=Nothing tu peux essayer d'ajouter la ligne
Code:
 OApp.Close
ou
Code:
OApp.End.
Ou encore
Code:
OApp.Quit

Je ne sais pas laquelle de ces methodes est utilisée par Automation dans Outlook. Mais cela vaut le coup d'essayer.

Aller, Je vais manger.
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Bon appétit à toi alors


Je vais tester ta modifs: OApp.Close (ne fonctionne pas)

Ce qui est bizarre c'est qu'avec le code VBA d'origine: arlToAddresses.Add "toto@toto.fr"
cela semble fonctionner

Avec cette modif ( mais uniquement si on lance la macro à partir de VBE)
WshShell.SendKeys "^{ENTER}"
le mail est mis dans la boite d'envoi (sans être envoyer")

Si quelqu'un peut m'expliquer pourquoi, merci.

PS: avec le code original
WshShell.SendKeys ("%s")
C'est Nouveau Message qui est activé ce qui est normal
car cela correspond à ALT+S
Nouveau Message

Et si je remplace par CTRL+S, il ne passe rien pourquoi?
WshShell.SendKeys ("^S")
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re à tous


Pour tous ceux que cela intèresse.

Voici la dernière version quasi-fonctionnelle: Ce lien n'existe plus
(testée avec XL2000 + Windows 98SE - méthode Outlook")

Le code VBA fait la chose suivante:
  • Crée un mail ayant pour destinataires les adresses mail situées en A1:A5
  • Dépose ce mail dans la boite d'envoi (sans envoyer le mail)
  • puis ferme Outlook.
Je ne sais pas s'il est possible d'envoyer directement le mail de manière transparente.

Si vous voulez tester correctement, mettez votre propre adressse mail
pour vérifier le bon fonctionnement.

PS: ce code fonctionne avec Outlook pas avec Outlook Express.

Remerciements: à l'auteur du code VBA: Edward Tanguay, contenu dans ce classeur
et à Hasco pour son aide.
 
Dernière édition:
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

bonjour Staple1600,

Je suis content que tu aies trouvé une solution à ton problème.

Pour respecter la protabilité de la classe j'ai un peu modifié le module de classe(voir le zip qui contient un fichier cls)

De plus il y avait me semble-t-il une petite erreur dans la classe d'origine, méthode 'Add(objItem as Variant)' qui faisait qu'en fin de liste le tableau contenait toujours une chaine vide. C'est corrigé.

A bientôt
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Bonjour Hasco

En incluant ton module de classe, j'ai une erreur sur cette ligne
arlToAddresses.Add (ActiveSheet.Range("A1:A5"))

Désolé je suis mal réveille ce matin
En remplaçant par:
arlToAddresses.AddxlRangeItems (ActiveSheet.Range("A1:A5"))
C'est OK.

Il reste un problème que je ne comprends toujours pas
Quand je lance la macro à partir de VBE, Outlook se ferme bien à la fin de la macro
Mais quand je lance cette même macro à partir de la feuille elle même Outlook ne se ferme pas.

Si quelqu'un peut m'expliquer pourquoi, merci à lui d'avance.

PS: Ci-joint la version incluant le module de classe d'Hasco
Ce lien n'existe plus
 
Dernière édition:
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re bonjour,

C'est souvent que les application ouverte par CreateObject on du mal à se fermer. Parfois elles semble fermées mais si tu fais CTRL-ALT-SUPPR tu verras qu'elle tourne peut-être toujours. La méthode que j'emploie dans ce cas là est celle-ci:
Code:
'
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 
         (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
 '
 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ 
         (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
 '
 Private Const WM_CLOSE  = &H10 
 Private Const HTCAPTION  = 2& 
 '
 Private Const MON_TITRE     As String = [B]"Titre de l'application Outlook"[/B] 
 '
 '
 Private Sub FermerApplication() 
     Dim lHwnd As Long 
     lHwnd = FindWindow(vbNullString, MON_TITRE) 
 
     If lHwnd = 0 Then 
         MsgBox "L' application " & MON_TITRE  & " est introuvalble!"
     Else 
         Call SendMessage(lHwnd, WM_CLOSE, HTCAPTION, ByVal 0&) 
     End If 
 End Sub

Bien sûr tu peux mettre tout ceci dans le module qui gère l'envoi des mail.

En espérant que cela marche, bon courage
 
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Au fait

Remplacer le titre dans la constante

Private Const MON_TITRE As String = "Titre de l'application Outlook"

C'est dur d'oublié toujours quelque chose!!!!!!!!!!!!!!!!!!!!!!!
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re

Finalement je viens de trouver le pourquoi

La solution:
WshShell.SendKeys ("%y")

En cherchant sur le net plus d'infos, je suis tombé sur ce script VBS

Je l'ai adpaté pour VBA

Mais il me reste un petit souci: (plus de détails dans la pièce jointe)

LA question étant:

Comment doit être formaté le fichier Texte maillist.txt
pour qu'un mail unique soit créé avec tous les destinaires du fichier texte?

PS: pour tester , décompresser dans c:\temp
 
Dernière édition:
G

Guest

Guest
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re, re ,re...

voici tes deux procédures un peu remanier, je n'ait pas tout tester, n'ayant pas OutLook.

Code:
Sub test()
Dim arrTemp(), tmp
Dim i As Integer, n As Integer
Dim fso, f
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set f = objFSO.OpenTextFile(Maillist, ForReading)
n = 0
Do While f.AtEndOfStream <> True
    'the second argument of the splitfunction is the separator (here it's a tab)
    ' tableau temporaire des adresses de la ligne en cours
    tmp = Split(f.ReadLine, Chr(59))
    'wscript.echo arrtemp(0) & " " & arrtemp(1)

    For i = 0 To UBound(tmp)
        ReDim Preserve arrTemp(n)
        arrTemp(n) = tmp(i)
        n = n + 1
    Next
Loop
    'Envoyer les mails une fois toutes les adresses chargées
    SendMail (arrTemp)

End Sub

Function SendMail(strSMTP)
    Dim i As Integer, cpt As Integer
    Dim TxtMessage
    Dim strEmail
    Dim strMsg
    Dim oLook
    Dim oMail
    If IsArray(strSMTP) Then
        TxtMessage = ReadBody(BodyFile)
        cpt = UBound(strSMTP)
        
        'Set WshShell = CreateObject("WScript.Shell")
        'Set oLook = CreateObject("Outlook.Application")
        For i = 0 To cpt - 1
            Set oMail = oLook.createitem(0)
            With oMail
                .To = strSMTP(i)
                .body = TxtMessage
                .Subject = "Compte-rendu de la dernière réunion"
                '.Attachments.Add (strAttachments)
                .Display
                'wscript.sleep (Now + TimeValue("0:00:02"))
            End With
        Next
        ' envoi des message
        WshShell.SendKeys "%y"
        Set oMail = Nothing
        Set oLook = Nothing
    End If

End Function


Mais là aussi l'idéal serait d'écrire un module qui gère la collection des adresses.
 

Staple1600

XLDnaute Barbatruc
Re : [VBA] Excel-Outlook -Demande Explication code (module de classe)

Re Hasco


Merci pour ton aide

Moi j'en étais arrivé là (lol)

Code:
Sub test()
Dim destinataires As String
Dim i As Long
Dim fso, f
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set f = objFSO.OpenTextFile(Maillist, ForReading)
Do While f.AtEndOfStream <> True
destinataires = f.ReadLine
Call SendMail(destinataires)
Loop
End Sub

Avec un fichier texte formaté ainsi
toto@yahoo.fr;tati@yahoo.fr; ect
le tout, sur une seule ligne


Je vais tester ton code de ce pas.
 

Staple1600

XLDnaute Barbatruc
Dernière édition:

Discussions similaires

Réponses
4
Affichages
1 K

Membres actuellement en ligne

Statistiques des forums

Discussions
312 229
Messages
2 086 425
Membres
103 206
dernier inscrit
diambote