juiste e-mailaccount aangeven in code als afzender

[Andre175]

goedenavond....


Ik heb naar mijn idee mijn code voor het verzenden van een paar honderd emails met de juiste bijlage bij iedere mail nu bijna perfect.
Ik zit alleen nog met 1 probleempje.

In Outlook heb ik meerdere Accounts, en het standaard account in outlook is niet het mailadres wat ik nodig ben voor deze code.
Nu worden alle mails nog verstuurd vanaf mijn eigen pc, dus lukt het me wel om het juiste afzender account te verkrijgen
Het is echter de bedoeling dat andere personen er ook mee gaan werken.
Niet iedereen heeft het te gebruiken afzender account op dezelfde plek staan in Outlook.

Met onderstaande code is het mogelijk het juiste afzender account in te stellen.
(met dank aan Ron de Bruin)

Sub Mail_small_Text_Change_Account()
'Only working in Office 2007-2016
'Don't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String

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

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        'SendUsingAccount is new in Office 2007
        'Change Item(1)to the account number that you want to use
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)

        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Hier wordt vooraf in de code het juiste account ingesteld.
Is het mogelijk dat de gebruiker, wanneer diegene mails wil verzenden, éénmalig de vraag krijgt gesteld welk afzender account hij wil gebruiken?

 

[HSV]

Verander het blauwe gedeelte.

Sub hsv()
Dim strbody As String, mailaccount, objOutlook As Object, objOutlookAccount As Object
  Set objOutlook = CreateObject("Outlook.Application")
  Set objOutlookAccount = GetOutlookAccount(objOutlook, [COLOR=#0000cd]"hierhetmailaccount@gmail.com")[/COLOR]
  With objOutlook.createitem(0)
    Set .sendusingaccount = objOutlookAccount
        .To =[COLOR=#3E3E3E]"ron@debruin.nl"[/COLOR]
        .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

 

[snb]

Sub M_snb()
    c00 = InputBox("welk emailaccount")

    With CreateObject("Outlook.Application")
       For j = 0 To 100
        With .createitem(0)
          .To = "hsv@helpmij.nl"
          .Subject = "Evident"
          .Body = "minder evident"
          .SentOnBehalfOfName = c00
        End With
      Next
    End With
End Sub

of ?

Sub M_snb()
  With CreateObject("Outlook.Application")
    For Each it In .Accounts
      c00 = c00 & vbLf & it.UserName
    Next
    c01 = InputBox(c00, "welk emailaccount")
       
    For j = 0 To 100
      With .createitem(0)
        .To = "hsv@helpmij.nl"
        .Subject = "Evident"
        .Body = "minder evident"
        .SendUsingAccount = .Parent.Accounts(c01)
      End With
    Next
  End With
End Sub

 

[HSV]

Ik had die in het verleden ook zo geschreven @snb, maar kwam er achter dat die niet werkt.
Toevallig heb ik ook twee accounts dus nu toch maar eens weer getest.

Helaas.

Grappig dat je me er 101 keer wil in laten stinken.

 

[gober]

Kun je onderstaande code niet gebruiken? Hij verzend dan wel van eigen mail adres, maar het lijkt alsof de mail komt van onderstaand adres.

With OutMail
       .SentOnBehalfOfName = """Naam"" <Email@mail.com>"

 

[Andre175]

alvast bedankt voor e reacties, ik ga hier mee aan het puzzelen.

@HSV....
Als het account (nog) niet bestaat, dan komt er vast een foutmelding.
m.a.w. ... dan is het handig dat er een messagebox in beeld komt dat het account eerst in outlook moet worden aangemaakt.

 

[Andre175]

@ gober

Het is niet de bedoeling dat men mijn andere mailadres kan achterhalen.
Voor wat ik ergens gelezen heb, is dat met de oplossing die jij geeft wel mogelijk.

 

[snb]

@HSV

Als je het doet, moet je het ook maar meteen goed doen, lijkt mij.

 

[HSV]

Sub hsv()
Dim strbody As String, mailaccount, objOutlook As Object, objOutlookAccount As Object, s00 As String
  Set objOutlook = CreateObject("Outlook.Application")
  s00 = Application.InputBox("geef afzenderaccount in", "????", , , , , , 2)
  Set objOutlookAccount = GetOutlookAccount(objOutlook, s00)
  If Not objOutlookAccount Is Nothing Then
  With objOutlook.createitem(0)
    Set .sendusingaccount = objOutlookAccount
        .To = "hup"
        .Subject = "Onderwerp"
        .body = "De groeten van @hsv"
        .display
 End With
 Else
 MsgBox "account bestaat niet"
 End If
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

 

[pasan]

http://www.rondebruin.nl/win/s1/cdo.htm
heb je je hier al eens in verdiept?

 

[Andre175]

@ Pasan

Lijkt me een goed alternatief, ondanks dat ik de code gedeeltelijk behoorlijk moet aanpassen.
Het maakt het bestand idd onafhankelijk van outlook, dus breder inzetbaar.

Ik heb de komende tijd ff wat minder tijd om hiermee aan de slag te gaan, maar kom er zeker op terug om te laten weten of het gelukt is. :thumb:



André

 

[HSV]

Kijk toch eens verder als je neus lang is.
Heeft er verder niemand gereageerd?

 

[Andre175]

@ HSV

Jazeker hebben er meer gereageerd, waarvoor mijn dank.
Ik geef alleen aan dat ik ook de optie die Pasan voorstelde te bekijken.
Wat uiteindelijk voor mij de beste oplossing wordt, laat ik wel horen.
Zodat anderen er misschien ook iets aan hebben als men een vergelijkbaar probleem hebben.


André

 

[Andre175]

Ik ben er voor mezelf wel uit.

Ik ga het zo maken dat de mails met outlook worden verzonden aangezien er ook herinneringsmails verzonden gaan worden.
Deze herinneringsmails worden op een vast tijdstip verzonden,en met outlook is er een mogelijkheid deze mails op elk moment klaar te zetten.
Het excel bestand wat ik aan het maken/verbeteren ben is voor een vrijwilligersgroep. Zij organiseren 2 x per jaar een 30- tot 40-tal evenementen waar zo'n 300 tot 400 kinderen zich voor op kunnen geven.
De evenementen zijn verdeeld over een aantal maanden.
Voorheen werd de planning op papier gedaan, en kregen de kinderen via de scholen een briefje mee waar ze aan mee mochten doen.
Behoorlijk wat uren werk dus.
De laatste 2 x dat er gepland moest worden, is in excel gedaan. Geen briefjes meer maken en uitdelen maar alles via de mail.
We hebben gemerkt dat ouders toch vergeten dat hun kind is opgegeven voor een evenement, zeker als het wat later in het seizoen is.
Vandaar een herinnering op vrijdag voor de 2 weken daarop. We hopen het de opkomstpercentage hoger zal worden. Wel zo fijn voor diegene die het evenement organiseert.

Ik neem als basis de code die HSV in #9 aangeeft omdat outlook de optie heeft om mails te verzenden op een vooraf aangegeven tijdstip.


Ik kom weer een stuk verder dankzij de reacties op mijn vraag.
Ook namens alle vrijwilligers die zich inzetten voor het organiseren van alle evenementen, hartelijk dank.


André