Access VBA mail from wrong sender

[jorgvberlo]

Hoi allen,
Ik ben relatief nieuw / onbekend met MS Access, maar mag graag een beetje met programmacode klooien. Onlangs heb ik (eerlijk is eerlijk) middels veel google, knippen en plakken, een mail progje gemaakt. Werkt als een zonnetje, maar ik krijg de mails niet verzonden vanaf het juiste account. Het gebruikte account is niet eens het hoofdaccount.

Hier de code:

Public Sub SendEmailOutlook(strBcc As String, strSubject As String, strBody As String, _
    strFile As String, Optional bFileAttach As Boolean = False, Optional bPreview As Boolean = False)

    On Error GoTo SendEmailOutlookErr

    Dim strEmail As String
    Dim strMsg As String
    Dim oLook As Object
    Dim oMail As Object
    Dim MyDB As DAO.Database
    Dim rstEMail As DAO.Recordset
    
    Set oLook = CreateObject("Outlook.Application")
    Set oMail = oLook.createitem(0)
Set MyDB = CurrentDb
Set rstEMail = MyDB.OpenRecordset("Select Email From Tbl_contact", dbOpenSnapshot, dbOpenForwardOnly)
 
With rstEMail
  Do While Not .EOF
    'Build the Recipients String
    strEmail = strEmail & ![Email] & ";"
      .MoveNext
  Loop
End With
With oMail
  .Bcc = Left$(strEmail, Len(strEmail) - 1)        'Remove Trailing ;
        '.body = sBody
        .htmlbody = strBody
        .Subject = strSubject
        .SentOnBehalfOfName = """[naam]""<[ownemail@adres]>"
        If strFile <> "" Then
            .Attachments.Add (strFile)
        End If
        If bFileAttach = True Then
            'THIS IS WHERE YOU CODE YOUR FORM TO ATTACH FILE(S)...
            '.Attachments.Add (CurrentProject.Path & "XYZ.XXX")
        End If
        If bPreview = True Then
            .display
        Else
            .Send
        End If
    End With
    
    If bPreview = False Then
        Set oMail = Nothing
        Set oLook = Nothing
    End If
    Exit Sub
    
SendEmailOutlookErrExit:
        Exit Sub
   
SendEmailOutlookErr:
        MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
        Resume SendEmailOutlookErrExit
rstEMail.Close
Set rstEMail = Nothing
End Sub

.SentOnBehalfOfName werkt, maar er staan twee afzenders in de mail (reply all geeft een reactie aan het goede mail adres).
Door al mijn aanpassingen waarschijnlijk geen hele nette code meer, maar het volstaat voor mij.
Graag suggesties...

 

[jorgvberlo]

Niemand een idee????

 

[OctaFish]

Ik heb je code bekeken, en ook waar je 'm vandaan hebt, en ik zie er weinig bijzonders aan. Ik zou dus niet weten waarom het niet werkt. Maar een topic dat ik vond (met vergelijkbare code) vond de oplossing in het aanpassen van de volgorde van de regels. Probeer dit eens:

    Set rstEMail = CurrentDb.OpenRecordset("Select Email From Tbl_contact", dbOpenSnapshot, dbOpenForwardOnly)
    With rstEMail
        Do While Not .EOF
            If Not strEmail = "" Then strEmail = strEmail & ";"
            strEmail = strEmail & ![Email]
            .MoveNext
        Loop
    End With
    Set oLook = CreateObject("Outlook.Application")
    Set oMail = oLook.createitem(0)
    With oMail
        .SentOnBehalfOfName = """[naam]""<[ownemail@adres]>"
        .Display
        .Bcc = strEmail
        .htmlbody = strBody
        .Subject = strSubject
        If strFile <> "" Then .Attachments.Add (strFile)
    End With

Je code kon overigens wat compacter, dus dat heb ik er maar gelijk (free of charge) maar gelijk bij gedaan .

 

[jorgvberlo]

TNX....
Helaas, geen oplossing. Hij blijft in de mail een zelden gebruikt email adres weergeven. Ik heb echt geen idee waar dit wordt veroorzaakt.