Código para abrir un correo electrónico y adjuntar archivos seleccionados
Estoy necesitando quien me de una mano con un formulario desde el cual quisiera al apretar un botón se envíe un correo en el cual yo pueda seleccionar archivos desde una determinada ruta y adjuntarlos al mismo. No se si es posible.
1 respuesta más de otro experto
Si el botón de tu formulario tuviera el nombre "Correo", esta sería la forma de enviar un correo al dar click. Solamente debes tener instalado outlook. Suerte
Private Sub Correo_Click()
Dim Adjunto1 As String
Dim Adjunto2 As String
Dim CorreoReceptor As String
Dim xEmpresa As String
Dim xRuta_App As String
Dim Tim As Recordset
xEmpresa = DLookup("Nombre", "Emisor", "Emisor='" & emisor & "'")
CorreoReceptor = DLookup("Correo", "Receptor_Correo", "Receptor='" & Receptor & "'")
'Obtener rutas de archivos a enviar
Set Db = DBEngine(0)(0)
strSQL = "Select * From Timbrado Where Emisor='" & emisor & "'"
Set Tim = Db.OpenRecordset(strSQL)
If Tim.RecordCount > 0 Then
Adjunto1 = Tim!ruta_xml_timbrado & "\" & serie & folio & "-" & Receptor & ".xml"
Adjunto2 = Tim!Ruta_App & "CFDI_PDF\" & serie & folio & "-" & Receptor & ".pdf"
End If
'Es necesario añadir la refeerncia Microsoft Outlook Library (herramientas/referencias)
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = CorreoReceptor
.CC = ""
.BCC = ""
.Subject = xEmpresa & " Comprobante Fiscal Digital por Internet"
. Body = "Por este medio estamos adjuntando el CFDI en formato PDF y XML de la compra que realizó con nosotros. Agradecemos su preferencia."
'Se pueden adjuntar ficheros
. Attachments. Add Adjunto1
. Attachments. Add Adjunto2
'. Display 'tambien se puede usar .Send y lo situa en la bandeja de salida
. Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Correo Enviado a: " & CorreoReceptor, vbInformation, "Envío de Correo"
End Sub