Mail verzenden met niet standaard adres

[karel1982]

Ik heb 2 accounts in mijn Outlook.
karel@mailadres.be
no-reply@mailadres.be


Ik gebruik onderstaande code om mails te versturen.
Hoe kan ik er voor zorgen dat de mail altijd verstuurd wordt vanaf het adres 'no-reply@maildres.be'?

Sub PDFEmail()

Set OutApp = GetObject(, "Outlook.Application")
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
xOutMsg = "Beste klant,<br/><br />" & _
          "Binnen afzienbare tijd <br/><br />" & _
          "Dit is een automatisch verstuurde mail. Op deze mail kan niet geantwoord worden."
With OutMail
.To = Range("F3").Value
.CC = ""
.BCC = ""
.Subject = "Planning productie"
.HTMLBody = xOutMsg
'.HTMLBody = xOutMsg & "<br/>" & "<img scr = 'c:\Gebruikers\gebruiker\AppData\Roaming\Microsoft\Signatures\Logo.png'/>"
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[LucHeyndrickx]

Probeer dit eens:

Sub PDFEmail()

Set OutApp = GetObject(, "Outlook.Application")
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
xOutMsg = "Beste klant,<br/><br />" & _
          "Binnen afzienbare tijd <br/><br />" & _
          "Dit is een automatisch verstuurde mail. Op deze mail kan niet geantwoord worden."
With OutMail
.SentOnBehalfOfName = "no-reply@mailadres.be"
.To = Range("F3").Value
.CC = ""
.BCC = ""
.Subject = "Planning productie"
.HTMLBody = xOutMsg
'.HTMLBody = xOutMsg & "<br/>" & "<img scr = 'c:\Gebruikers\gebruiker\AppData\Roaming\Microsoft\Signatures\Logo.png'/>"
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[karel1982]

Wordt nu verstuurd via "no-reply@mailadres.be", maar in de ontvangen mail zie ik nog steeds "karel@mailadres.be" staan.
Dit zou ik willen vermijden.

 

[LucHeyndrickx]

Wanneer je in de VBA editor naar Extra => verwijzingen gaat, vind je daar de objectenbibliotheek: Microsoft Outlook (Uw versienummer) Object Library. Klik die aan.

Vervolgens kan je je objecten ook juist declareren (in plaats van ze telkens als object te behandelen)

Dim OutApp as Outlook.Application
Dim OutMail as Outlook.CreateItem(0)
Set OutApp = New Outlook.application
set OutMail = New OutApp.CreateItem(0)

Als je vervolgens OutMail typt... en een punt er achter, zie je alle mogelijkheden die er zijn.
Het is niet mijn gewoonte om in Outlook te programmeren, vandaar ook dat mijn eerste code wellicht niet doet wat je wenst, maar je kan andere mogelijkheden wel 's uitproberen. Er zijn er nog zoals Sender.

Als je programma op meerdere computers gebruikt wordt, ben je wel best om die verwijzing terug weg te halen, en opnieuw met Late binding te werken, zoals je bezig was. Maar de manier die ik hier geef, geeft je wel de mogelijkheid om het één en ander zelf uit te testen.

 

[edmoor]

Doe het eens zo. Dat is inclusief de handtekening:

Sub PDFEmail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim OutAccount As Object
    Dim Handtekening As String
    
    Set OutApp = CreateObject("Outlook.Application")
    
    [COLOR="#008000"]'Bepaal het te gebruiken verzender account ---------------------[/COLOR]
    For i = 1 To OutApp.Session.Accounts.Count
        If OutApp.Session.Accounts.Item(i) = "no-reply@maildres.be" Then
            Set OutAccount = OutApp.Session.Accounts.Item(i)
        End If
    Next i
    If OutAccount Is Nothing Then
        MsgBox "Het account no-reply@maildres.be werd niet gevonden", vbCritical, "Account niet gevonden"
        Set OutApp = Nothing
        Exit Sub
    End If
    [COLOR="#008000"]'----------------------------------------------------------------[/COLOR]

    xOutMsg = "Beste klant,<br/><br />" & _
          "Binnen afzienbare tijd <br/><br />" & _
          "Dit is een automatisch verstuurde mail. Op deze mail kan niet geantwoord worden."
    
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        Set .SendUsingAccount = OutAccount
        .Display
        Handtekening = .HTMLBody
        .To = Range("F3").Value
        .CC = ""
        .BCC = ""
        .Subject = "Planning productie"
        .HTMLBody = xOutMsg & "<br>" & Handtekening
        .Send
    End With
    
    Set OutAccount = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[HSV]

Of:

Sub hsv()
Dim  objOutlookAccount As Object, xOutMsg as string
xOutMsg = "Beste klant,<br/><br />" & _
          "Binnen afzienbare tijd <br/><br />" & _
          "Dit is een automatisch verstuurde mail. Op deze mail kan niet geantwoord worden."

 With CreateObject("Outlook.Application").createitem(0)
    Set .SendUsingAccount = .session.accounts.Item("[EMAIL="no-reply@mailadres.be"]no-reply@mailadres.be[/EMAIL]")
       .To = Range("F3").Value
       .Subject = "Planning productie"
       .HTMLBody = xOutMsg
       .HTMLBody = xOutMsg & "<br/>" & "<img scr = 'c:\Gebruikers\gebruiker\AppData\Roaming\Microsoft\Signatures\Logo.png'/>"
       .Send
End With
End Sub

 

[karel1982]

@Edmoor, @HSV

Heb beide mogelijkheden getest, maar krijgen telkens een foutmelding op de account "no-reply@mailadres.be".

 

[edmoor]

Aan beide codes mankeert niets.
Daarnaast, als je zegt een foutmelding te krijgen, vertel er dan ook bij welke dat is.