Buenas tardes tengo dos cuentas configuradas(las dos Imap) en Outlook 2016 y quiero desde access enviar correos sólo desde la cuenta que tengo predeterminada en Outlook. El código que tengo en el formulario es el siguiente:
Dim OutLookApp As Outlook.Application
Dim vDest As String, vCC As String, vCCO As String
Dim miAsunto As String, miMsg As String
Dim oAccount As Outlook.Account
Set OutLookApp = New Outlook.Application
For Each oAccount In OutLookApp.Session.Accounts
If oAccount.AccountType = olImap Then
Dim Msg As Outlook.MailItem
Set Msg = OutLookApp.CreateItem(olMailItem)
vDest = Nz(Me.MailCont_vis, "")
'Cogemos el valor de la copia
vCC = Nz(Me.cboCC_vis.Value, "")
'Cogemos el valor de la copia oculta
vCCO = Nz(Me.cboCCO_vis.Value, "")
'Cogemos el valor del asunto
miAsunto = Nz(Me.txtAsunto_vis.Value, "")
'Cogemos el valor del cuerpo del mensaje
miMsg = Nz(Me.txtMsg_vis.Value, "")
'Si no existe mail para el destinatario lanza un mensaje de aviso y sale del proceso
Msg.BodyFormat = 2 'olFormatHTML
Msg.To = vDest
Msg.Subject = miAsunto
Msg.HTMLBody = miMsg
If acuse_vis = -1 Then
Msg.ReadReceiptRequested = True
Else
Msg.ReadReceiptRequested = False
End If
Msg.CC = vCC
Msg.BCC = vCCO
Msg.Attachments.Add CurrentProject.Path & "\curriculum.pdf"
If vDest = "" Then
MsgBox "vDest"
MsgBox "No existe mail donde enviar el informe", vbCritical, "AVISO"
Exit Sub
End If
Msg.SendUsingAccount = oAccount
If MsgBox("Se va a enviar un correo con Adjunto " & tipo + vbCrLf + "de: " & oAccount & vbCrLf + "para: " & vDest & vbCrLf + "CC: " & vCC & vbCrLf + "CCO: " & vCCO & vbCrLf + "Observe bien las direcciones de envío, ¿desea enviarlo? ", vbYesNo) = vbYes Then
If MsgBox("para: " & vDest & vbCrLf + "CC: " & vCC & vbCrLf + "CCO: " & vCCO & vbCrLf & tipo & vbCrLf + " Revise bien estas direcciones de correo electronico, ¿desea enviarlo? ", vbYesNo) = vbYes Then
If previa = -1 Then
Msg.Display
Else
Msg.Send
End If
DoCmd.OpenForm "enviando", , , , , acDialog
'MSGBOXEX " Mensaje enviado: " + vbCrLf + "para: " & vDest & vbCrLf + "CC: " & vCC & vbCrLf + "CCO: " & vCCO & vbCrLf + " De modo Satisfactorio", , , , , , CurrentProject.Path & "/cursores/correo.ani"
Else
Exit Sub
End If
Else
Exit Sub
End If
End If
Next
Else
Exit Sub
End If
Evidentemente con este código envío desde las dos cuentas, porque las dos son Imap