mail verzenden vanuit een vast account.

Andre175 · 23 feb 2018

Beste helpers.

het lukt me niet om de mail standaard van 1 van de 3 accounts te versturen via de macro.

stel ik heb de volgende 3 accounts in Outlook 2016

test1@test.nl
test2@test.nl
test3@test.nl

nu wil ik met de macro standaard vanuit test3@test.nl versturen.
In outlook staat test2@test.nl als standaard account
Toch pakt de macro als afzender test1@test.nl

Code:

Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrCC As String, StrBCC As String, StrSubject As String, _
                              Signature As Boolean, Send As Boolean, strbody As String, _
                               Leesbev As String)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .ReadReceiptRequested = Leesbev
        [COLOR="#FF0000"][B].SendUsingAccount = "<test3@test.nl>"[/B][/COLOR]
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If

rara hoe kan dit.

voor de rest werkt het allemaal supper, met dank aan Ron en uiteraard dit Forum.

PS... Een snelle oplossing is wel gewenst aangezien er vandaag 360 mails verzonden moeten worden.

SjonR · 23 feb 2018

Hoi André,

Ik heb thuis geen outlook, maar dit heb ik een keer op mijn werk gemaakt (met veel hulp van de cracks hier). Misschien heb je er wat aan.

Code:

Private Sub Mailakk()
Dim strbody As String, mailaccount, objOutlook As Object, objOutlookAccount As Object
  Set objOutlook = CreateObject("Outlook.Application")
  Set objOutlookAccount = GetOutlookAccount(objOutlook, "balbla@mail.nl")
  strbody = ""
  
  With objOutlook.createitem(0)
    Set .sendusingaccount = objOutlookAccount
        .SentOnBehalfOfName = .sendusingaccount
        .To = mail.Value
        .Subject = ""
        .body = strbody
        .display
 End With
End Sub

HSV · 23 feb 2018

Daar hoort nog wel deze functie bij.

Code:

Function GetOutlookAccount(objOutlook As Object, strEmailId As String) As Object
Dim objOAccount As Object
    For Each objOAccount In objOutlook.Session.Accounts
     If objOAccount.DisplayName = strEmailId Then
       Set GetOutlookAccount = objOAccount
       Exit For
     End If
    Next objOAccount
End Function

Andre175 · 24 feb 2018

HSV zei:

Daar hoort nog wel deze functie bij.

Code:

Function GetOutlookAccount(objOutlook As Object, strEmailId As String) As Object
Dim objOAccount As Object
    For Each objOAccount In objOutlook.Session.Accounts
     If objOAccount.DisplayName = strEmailId Then
       Set GetOutlookAccount = objOAccount
       Exit For
     End If
    Next objOAccount
End Function

Na een paar aanpassingen in Outlook, pakt ie nu wel het goede mailadres. Het is natuurlijk niet de bedoeling dat men eerst andere mailaccounts moet verwijderen in Outlook.
Er zijn straks meerdere personen die met het bestand gaan werken.

Wat jullie hier nu aangeven, was ik in een ander Topic ook al tegengekomen. Alleen in een proefbestandje geprobeerd maar nog niet werkend gekregen. Zal er straks toch eens mee verder gaan.
(Reageer nu vanaf mijn telefoon)
Gaat veel tijd in zitten dat gepuzzel... als het werkt is het toch weer een goed gevoel.

HSV · 24 feb 2018

Hierbij de gehele code; het zal je wat tijd besparen.

To, CC en/of BCC alsook de accountnaam "blabla@gmail.com" veranderen waar nodig.

Code:

Sub hsv()
Dim strbody As String, mailaccount, objOutlook As Object, objOutlookAccount As Object
  Set objOutlook = CreateObject("Outlook.Application")
  Set objOutlookAccount = GetOutlookAccount(objOutlook, "blabla@gmail.com")
  With objOutlook.createitem(0)
    Set .sendusingaccount = objOutlookAccount
        .To = ""
        .Cc = ""
        .Bcc = "naar@gmail.com"
        .Subject = "Onderwerp"
        .body = "De groeten van @hsv"
        .display
 End With
End Sub


Function GetOutlookAccount(objOutlook As Object, strEmailId As String) As Object
Dim objOAccount As Object
    For Each objOAccount In objOutlook.Session.Accounts
     If objOAccount.DisplayName = strEmailId Then
       Set GetOutlookAccount = objOAccount
       Exit For
     End If
    Next objOAccount
End Function

mail verzenden vanuit een vast account.

Andre175

Gebruiker

SjonR

Verenigingslid

HSV

Inventaris

Andre175

Gebruiker

HSV

Inventaris

Nieuwste berichten

Wij waarderen jouw privacy