Microsoft 365 Changer le compte par defaut VBA

sasuketm

XLDnaute Nouveau
Bonjour à tous,

Je planche sur un fichier qui me permette d'envoyer des mails automatiquement depuis excel.

Jusqu'ici tout fonctionne mais il y a un point qui me pose problème.

Possédant 2 adresses mails dans outlook j'arrive via le code à changer l'adresse mail de l'expéditeur mais lorsque j'envoie les mails j'ai un retour en erreur car le compte outlook par défaut prend le dessus :

Capture.JPG



Voici le code qui me permet de changer l'adresse de l'expéditeur :

VB:
Sub mailto_reception2()
With Sheets("Envoi confirmation recep UPS")
    dl = .Cells(Rows.Count, 2).End(xlUp).Row
   
    Set ol = CreateObject("outlook.application")
        '--boucle
    For i = 2 To dl
        '--choix envoi ("x" en colonne G) ou pas
        If Cells(i, 11) = "x" Then
        Cells(i, 12) = ""
        Set ml = ol.createitem(0)
        ml.To = .Cells(i, 6)
        ml.Subject = .Cells(i, 17)
        'ml.CC = .Cells(i, 10)
        'ml.BCC = .Cells(i, 11)
        ml.Body = .Cells(i, 18)
        '--afficher le mail
        'ml.SentOnBehalfOfName = "test@test.eu" change bien le mail d'expéditeur mais prend le compte par défault d'outlook
        ml.Display

        '--- si vous souhaitez envoyer directement
        'ml.send
        '--- afficher date et heure d'envoi
        Cells(i, 12) = Now
       '---demande AR
        'ml.OriginatorDeliveryReportRequested = True
        '---demande confirmation de lecture
        'ml.ReadReceiptRequested = True
        End If
    Next i
End With
End Sub

J'ai mis en commentaire la ligne qui me pose problème, il y a t'il une solution pour basculer le compte outlook ?.

Merci pour vos retour ;)
 
Dernière édition:

danielco

XLDnaute Accro
Bonjour,

Essaie :

VB:
Sub mailto_reception2()
Dim C As Account
With Sheets("Envoi confirmation recep UPS")
    dl = .Cells(Rows.Count, 2).End(xlUp).Row
    
    Set ol = CreateObject("outlook.application")
        '--boucle
    For i = 2 To dl
        '--choix envoi ("x" en colonne G) ou pas
        If Cells(i, 11) = "x" Then
        Cells(i, 12) = ""
        Set ml = ol.createitem(0)
        ml.To = .Cells(i, 6)
        ml.Subject = .Cells(i, 17)
        'ml.CC = .Cells(i, 10)
        'ml.BCC = .Cells(i, 11)
        ml.Body = .Cells(i, 18)
        '--afficher le mail
    With ml
        .Recipients.Add "test@test.com"
        For Each C In olApp.Session.Accounts
          If C.SmtpAddress = "enlevement-sav@kingtony.eu" Then
              .SendUsingAccount = C
              Exit For
          End If
        Next C
        .Display
        .Send
    End With
        ml.Display

        '--- si vous souhaitez envoyer directement
        'ml.send
        '--- afficher date et heure d'envoi
        Cells(i, 12) = Now
       '---demande AR
        'ml.OriginatorDeliveryReportRequested = True
        '---demande confirmation de lecture
        'ml.ReadReceiptRequested = True
        End If
    Next i
End With
End Sub

Il faut cocher la référence Microsoft Outlook 16.0 Object Library.

Cordialement.

Daniel
 

sasuketm

XLDnaute Nouveau
Suuuupeerrrr ça fonctionne merci danielco :)

Je vais paraitre un peu dans l'abus mais j'aurais un dernier point à voir si ça te dérange pas.

Dans le code suivant :

VB:
Sub Supprmail()
    Dim n%, i%  'Déclaration des variables
    Application.ScreenUpdating = False
    With Worksheets("mafeuil1") 'Nom de la feuille à modifier suivant le cas
        n = .Range("A" & .Rows.Count).End(xlUp).Row 'N° de la dernière ligne remplit
          For i = n To 2 Step -1 'Boucle de la dernière ligne remplit vers la ligne 2 (première ligne remplit) par PAS de -1
              If Range("A" & i) > 0 Then .Range("A" & i & ":E" & i).EntireRow.Delete 'si la ligne de la colonne A est = à 0 , suppression de la ligne
          Next i
    End With
End Sub


Je demande de supprimer des cellules sur "mafeuil1". Cela fonctionne mais seulement quand la feuille est active et pas quand je suis sur la feuille2 (là où est le bouton).

J'ai réussi à adapter ce code par rapport a mes besoins en faisant une vérification de la dernière cellule de la colonne A mais l'idéal serait que je puisse supprimer une zone entière plutôt. Du genre suppression de A2 à E500 par exemple.

Est-ce que tu serais m'aider pour ses 2 points ?

Merci encore pour ton aide !
 

Statistiques des forums

Discussions
311 730
Messages
2 081 991
Membres
101 856
dernier inscrit
Marina40