Inviare una mail da vba scegliendo uno specifico account Outlook

Anonimo
2019-08-28T07:54:25+00:00

Buongiorno, ho creato un report di nominativi che permette di selezionarne uno o più e inviare automaticamente una mail già preimpostata tramite Outlook 365. Il tutto funziona egregiamente (anche grazie a quanto trovato su questa community) ma non riesco ad impostare un account specifico come mittente. La mail, infatti, viene sempre spedita con l'account predefinito. Inoltre, se riuscissi ad identificare gli account potrei fare un controllo sull'esistenza o meno di quello da utilizzare come mittente.

Di seguito uno stralcio del codice che utilizzo:

. . .

    Dim olApp               As Object

Dim olNewMsg            As Object

. . . 

'   ----------------

'   Avvio Outlook

'   ----------------

On Error GoTo Error_Handler

'   Richiamo la funzione IsAppRunning per verificare se Outlook è attivo

If IsAppRunning("Outlook.Application") = True Then

'       Outlook was already running

'       Bind to existing instance of Outlook

Set olApp = GetObject(, "Outlook.Application")

Else

'       Could not get instance of Outlook, so create a new one 

'       Imposto il path di Outlook      

'       Determino il Path di Outlook (viene acquisito quello di Office 2016)

     sAppPath = GetAppExePath("Outlook.exe")        

'       Avvio Outlook

        On Error Resume Next

Shell (sAppPath)

Do While Not IsAppRunning("Outlook.Application")

DoEvents

Loop

On Error GoTo 0

'       Bind to existing instance of Outlook

        Set olApp = GetObject(, "Outlook.Application")

End If

. . .

'   Creo il nuovo item Outlook

Const olMailItem = 0

Set olNewMsg = olApp.CreateItem(olMailItem)

'   ---------------------------------------------------------

'   Avvio la scansione del recordset per individuare i record

'   selezionati e inviare le mail

'   ---------------------------------------------------------

  RS.MoveLast

RS.MoveFirst

    Do Until RS.EOF

'       Definisco la casella di destinazione: la mail personale o quella

'       aziendale se la prima non c'è

CasellaDest = RS.Fields("eMailPersonale")

If RS.Fields("eMailPersonale") & vbNullString = vbNullString Then _

CasellaDest = RS.Fields("eMailAziendale")

'       Creo il nuovo item Outlook

 Const olMailItem = 0

Set olNewMsg = olApp.CreateItem(olMailItem)    'Start a new e-mail message       

'       Imposto il Nome e Cognome del socio per la casella selezionata

        strNC = DLookup("Nome", "Soci", "ID_Socio=" & RS.Fields("ID_Socio")) & " " & DLookup("Cognome", "Soci", "ID_Socio=" & RS.Fields("ID_Socio"))

'       Compongo il testo HTML (solo se lancio la stampa per dati mancanti)

        sHtml = ""

If FormOpen("frmOpzioniDatiMancanti") = True Then

sHtml = sHtml & "<html><body>"

sHtml = sHtml & "<div style=""font-family:'Calibri', Segoe UI, Arial, Helvetica; font-size: 14px; max-width: 768px;"">"

sHtml = sHtml & "Gentile <b>" & strNC & "</b>,<br />"

sHtml = sHtml & "a seguito della nostra periodica attività di aggiornamento dati dei nostri soci le chiediamo cortesemente di comunicarci i suoi dati aggiornati.<br />"

sHtml = sHtml & "In particolare:<br />"

sHtml = sHtml & strMSG & "<br /><br />"

sHtml = sHtml & "Cordiali saluti<br/>"

sHtml = sHtml & "<b>Dircredito</b> - <i>Segreteria</i>"

sHtml = sHtml & "</div></html></body>"

End If

'       Imposto i parametri del messaggio e lo invio

        On Error Resume Next

        With olNewMsg

.To = CasellaDes****t

>>>>>>>>>       '.from = "******@gmail.com"

>>>>>>>>>****.SendUsingAccount = olApp.Session.Accounts.Item(2) 'l'indice parte da 1

.CC = ""

.BCC = ""

.HTMLBody = sHtml

'.Attachments.Add = "path allegato"

If FormOpen("frmOpzioniDatiMancanti") = False Then

.Subject = ""

.Display    ' per visualizzare il messaggio prima di inviarlo manualmente

Else

'.Send       ' per inviare il messaggio senza visualizzarlo

.Subject = "Richiesta dati"

.Display

End If

End With

On Error GoTo Error_Handler

'       Annullo la selezione del record

        RS.Edit

RS.Fields("InvioMail") = False

RS.Update

Me.Requery

'       Resetto la variabile oggetto

        Set olNewMsg = Nothing

'       passo al record successivo

        RS.MoveNext

Loop

. . .

Per la scelta dell'account ho provato i parametri 'From' e 'SendUsingAccount' ma nessuno dei due ha funzionato: il codice non da errore ma il messaggio continua ad avere come mittente l'account predefinito!

Spero che qualcuno possa aiutarmi.

Grazie.

Microsoft 365 e Office | Access | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti