Bonjour,

Je cherche a creer une macro qui envoie automatiquement un mail chaque mercredi matin (je compte remplir une celulle des qu'un mail est envoyé pour qu'il ne soit pas envoyé plusieurs fois) lorsque il est ecrit dans une cellule d'un fichier excel "to be updated", le rappel doit etre envoyé a une personne dont le mail est dans une autre feuille du fichier excel.

Mon programme marche mais le probleme est le suivant : le fichier est un fichier partagé, ce qui signifie que le mail de rappel sera envoyé depuis le compte de la personne connecté a ce moment.

Serait-il possible de choisir de quel compte est envoyé le mail, ou introduire une condition "si le compte est xxx@xxx.com, alors on envoie le mail" ?

Voici un echantillon de mon code 

Private Sub Workbook_Open()
    Dim OutApp As Object 'Déclaration de l'application objet Outlook
    Dim OutMail As Object 'Déclaration du mail objet Outlook
    Dim i As Integer
    i = 4

    date_test = CDate(Now)
    
    If Weekday(date_test, 2) = "3" Then '2 signfie que le premier jour est le lundi, par defaut le premier jour est le dimanche
            

        Do While Cells(i, 66).Value <> ""
            Sheets("xxxx").Select
            
            If Cells(i, 66).Value = "TO BE UPDATED" Then
                If Cells(i, 13).Value = "xxxxxx" Then
                    Set OutApp = CreateObject("Outlook.Application")
                    Set OutMail = OutApp.CreateItem(0)
                    
                    With OutMail
                        '.Sender = ""
                        '.SentOnBehalfOfName = ""
                        .To = "xxxxxxx@xxxx.com"
                        '.To = Worksheets("xxxxx").Range("E3").Value 
                        .CC = "" 
                        .BCC = ""
                        .Subject = "Reminder Component request" & Time() & propID
                                                                
                                                                
                        .Body = "Please update the status" & vbCrLf & ""
                                                                



                        '.Display 
                                 
                        .Send 
                        '.Save '
                    
                    End With
                    
                    Set OutMail = Nothing 
                    Set OutApp = Nothing 


             ActiveWorkbook.Worksheets("xxxxx").Range("A" & i).Value = "reminder sent to" & "" 'permet de ne pas envoyer le meme mail plusieurs fois
                End If
            End If
            i = i + 1
        Loop
    End If

Merci pour votre aide

-
Edité par yamak9 7 juin 2022 à 12:56:48

Bonsoir,

J'avais fais un programme en AutoIt qui devait récupérer et envoyer des mails via Outlook. La partie expéditeur était bien relou...

Tu peux peut-être t'en inspirer.

Pour récupérer l'@mail expéditeur d'un mail, j'avais fais ceci :

;Expéditeur ;Ligne ajouté
Local Const $sPR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001F" ;Ligne ajouté
Local Const $sPR_SENT_REPRESENTING_EMAIL_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x0065001F" ;Ligne ajouté
Local Const $sPR_SENT_REPRESENTING_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x5D02001F" ;Ligne ajouté
Local $iCheckEntryUserType ;Ligne ajouté
$aMembers[1][0] = 0 ;Recipients.Type (0 = Expéditeur)
$aMembers[1][1] = $vItem.PropertyAccessor.GetProperty($sPR_SENT_REPRESENTING_SMTP_ADDRESS) ;Récupère l'adresse mail "de la part de" (Externe et interne aussi ?) ou expéditeur (Externe et Interne)
If Not $aMembers[1][1] Then $aMembers[1][1] = $vItem.PropertyAccessor.GetProperty($sPR_SENT_REPRESENTING_EMAIL_ADDRESS) ;Récupère l'adresse mail "de la part de" (Externe uniquement ?) ou expéditeur (Externe uniquement ? Interne : /O/CN etc)
If Not StringRegExp($aMembers[1][1], '^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$') Then
    If $vItem.SenderEmailType = "EX" Then
 
        Local $TimerDiff = 0, $hTimer = TimerInit()
        Do
            $iCheckEntryUserType = $vItem.Sender.AddressEntryUserType ;https://msdn.microsoft.com/fr-fr/VBA/Outlook-VBA/articles/oladdressentryusertype-enumeration-outlook
            $TimerDiff = TimerDiff($hTimer)
            Sleep(200)
        Until IsNumber($iCheckEntryUserType) = 1 Or $TimerDiff >= 3000 ;Permet de palier au lenteur Outlook
        If $iCheckEntryUserType = 30 Or $TimerDiff >= 3000 Then
            $aMembers[1][2] = $vItem.Sender.PropertyAccessor.GetProperty($sPR_SMTP_ADDRESS)
        Else
            $aMembers[1][2] = $vItem.Sender.GetExchangeUser().PrimarySmtpAddress ;Provoque une erreur sur un certain type d'adresse mail (30 only ?)
        EndIf
 
    Else
        $aMembers[1][2] = $vItem.SenderEmailAddress
    EndIf
EndIf

Pour définir une @mail expéditeur :

;Récupère la liste des comptes et compare $De avec les comptes. Si ok, le compte est mis comme expéditeur du mail.
For $oAccount In $oOutlook.Session.Accounts
    If $De = $oAccount.SMTPAddress Or $De = $oAccount.DisplayName Or $De = $oAccount.UserName Then
        $oItem.SendUsingAccount = $oAccount
        $oItem.Sender = $oAccount.CurrentUser.AddressEntry
        $DeValid = 1
        ExitLoop
    EndIf
Next
 
;Si SendUsingAccount est NOK, on essaye avec SentOnBehalfOfName ("De la part de") ;https://social.msdn.microsoft.com/Forums/office/en-US/c2ae3f49-3ef9-4b0c-9698-3f682f6f05b8/how-to-set-the-mailitem-sentonbehalfof?forum=vsto
If $DeValid <> 1 Then
    Local Const $sPR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001F"
    Local Const $sPR_SENT_REPRESENTING_ENTRYID = "http://schemas.microsoft.com/mapi/proptag/0x00410102"
    Local Const $sPR_SENT_REPRESENTING_NAME = "http://schemas.microsoft.com/mapi/proptag/0x0042001F"
    Local Const $sPR_SENT_REPRESENTING_EMAIL_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x0065001F"
    Local $oRecipientDe, $oAddressEntryDe, $iCheckAddressEntryUserTypeDe, $oPR, $bSentOnBehalfOfName, $iCount = 0
 
    ;Créer un récipient et tente de le resolve
    $oRecipientDe = $oOutlook.Session.CreateRecipient($De)
    $oRecipientDe.Resolve
 
    ;Boucle avec plusieurs tentatives de resolve l'adresse mail (AddressEntry force le resolve ; Permet de palier au lenteur Outlook)
    Do
        $iCount+=1
        $oAddressEntryDe = $oRecipientDe.AddressEntry
        $iCheckAddressEntryUserTypeDe = $oAddressEntryDe.AddressEntryUserType
        Sleep(200)
    Until IsNumber($iCheckAddressEntryUserTypeDe) = 1 Or $iCount >= 3
 
    If $oRecipientDe.Resolved Then
        $oPR = $oItem.PropertyAccessor
        $oPR.SetProperty($sPR_SENT_REPRESENTING_ENTRYID, $oPR.StringToBinary($oAddressEntryDe.ID))
        $bSentOnBehalfOfName = $oItem.SentOnBehalfOfName = $oAddressEntryDe.Name
        If Not $bSentOnBehalfOfName Then $oPR.SetProperty($sPR_SENT_REPRESENTING_NAME, $oAddressEntryDe.Name)
        $oPR.SetProperty($sPR_SENT_REPRESENTING_EMAIL_ADDRESS, $oRecipientDe.PropertyAccessor.GetProperty($sPR_SMTP_ADDRESS))
        $DeValid = 2
    Else
        $EnvoiDirect = $GUI_UNCHECKED
        MsgBox(48, "Avertissement Outlook", "L'expéditeur renseigné dans le modèle n'est pas reconnu/valide.", 0, $GUIP)
    EndIf
EndIf

-
Edité par Zaibai 7 juin 2022 à 21:14:51

Le truc c'est ton code ouvre le outlook du poste où est ouvert le fichier excel, donc l'utilisateur qui ouvre le fichier excel.
Sinon, il faudrait essayer de mettre ton adresse voulue dans le .SentOnBehalfOfName (mais je crois qu'il faut que les personnes ouvrant excel aient une délégation sur ce compte de messagerie).

Mais sinon comme tu le proposais, tu peux regarder le nom de l'utilisateur ouvrant le fichier et si il ne correspond pas à certains utilisateurs ne rien faire

Sub Test()
    Dim currentUserName As String, authorizedUserNames
    Dim currentUserAccount As String, authorizedUserAccounts
    currentUserName=Application.UserName 'nom utilisateur dans Excel
' ou
    currentUserAccount=Environ("username") 'nom du compte windows de la session

    authorizedUserNames=Array("Utilisateur1","Utilisateur2",...) 'ex: "Prénom NOM"

'ou
    authorizedUserAccounts=Array("Compte1","Compte2", ...) 'ex: prenom.nom

    If isInArray(currentUserName,authorizedUserNames) Then
     'envoi du mail
    End If
'ou
    If isInArray(currentUserAccount,authorizedUserAccounts) Then
     'envoi du mail
    End If
End Sub
.....

Function isInArray(value, lArray) As Boolean
    Dim v
    For Each v In lArray
        If value = v Then
            isInArray = True
            Exit For
        End If
    Next v
End Function

ou tu dois aussi pouvoir vérifier le outmail.sender

-
Edité par umfred 13 juin 2022 à 17:52:06