Enviar email con Outlook 365 desde formulario Access
Utilizo un botón en formulario access para enviar correo electrónico. El código envía desde el outlook de office y no me aparece después en el outlook 365 como enviado.
Quisiera que el código me enviara el email desde outlook 365 directamente sin pasar por outlook de office.
El código que utilizo al hacer click es el siguiente:
Private Sub Comando270_Click()
If Nz(Me.vale, "") = "" Then Exit Sub
Dim RutaArchivo As String
RutaArchivo = CurrentProject.Path & "\VP_pdf\" & Me.vale & ".pdf"
If Dir$(RutaArchivo) = "" Then
MsgBox "VP NO ESCANEADO", vbInformation, "AVISO"
Else
If IsNull(Me.Mail2) Or Me.Mail2 = "" Then
MsgBox ("HAGA DOBLE CLICK EN ZONA PARA AÑADIR EMAIL"), vbInformation, "AVISO"
Exit Sub
Else
Dim Pregunta As Integer
Dim Fecha_envio2
Pregunta = MsgBox("¿SEGURO QUE QUIERES ENVIAR EMAIL?", vbOKCancel, "AVISO")
If Pregunta = 2 Then
Exit Sub
End If
Dim pola As Outlook.Application
Dim pTaskItem, ptaskitemasig As Outlook.TaskItem
Const olCreateTasks = 3
Const olDialog = 1
Const olSound = 8
Set pola = CreateObject("Outlook.Application")
sSubject = "PEDIDO " & Ficha & ""
sBody = "Su pedido " & Ficha & " Se encuentra preparado en Almacén Central para ser retirado." + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + vbCrLf + "" + "César Galera González" + vbCrLf + "Almacén Central" + vbCrLf + "Servicio de Mantenimiento" + vbCrLf + "Universidad de Sevilla" + vbCrLf + "Tlfs. 955420276" + vbCrLf + "[email protected]"
dDue = Now()
dStart = Now()
sSoundFile = "alarm3"
bReminderSet = False
Set pTaskItem = pola.CreateItem(olCreateTasks)
pTaskItem.Subject = sSubject
pTaskItem.Body = sBody
pTaskItem.DueDate = dDue
pTaskItem.StartDate = dStart
pTaskItem.ReminderSet = bReminderSet
If bReminderSet Then
pTaskItem.ReminderSoundFile = sSoundFile
pTaskItem.ReminderTime = Now()
End If
pTaskItem.Recipients.Add ("" & Me.Mail2 & "")
pTaskItem.Attachments.Add CurrentProject.Path & "\VP_pdf\" & Me.vale & ".pdf"
pTaskItem.Save
pTaskItem.Assign
pTaskItem.Send
Set pTaskItem = Nothing
Set pola = Nothing
Me.Enviado2 = True
Me.Fecha_envio2 = Date
End If
End If
End Sub
