Agregar resultados de Query mediante Outlook
Publicado por Rafael Noguera (1 intervención) el 14/08/2014 01:59:42
Hola,
Esta es la situación, tengo una query que genera cierta información y deseo poder enviar esos resultados en el cuerpo del correo en Outlook (.HTMLBody) mediante vba sin tener que exportar y agregarlo como un archivo adjunto.
Puedo hacer que los registros queden en el portapapeles y abrir el correo, sin embargo tengo que presionar CTRL + V para pegar los resultados.
Cabe mencionar que he activado las referencias Microsoft Outlook 12.0 / Microsoft Forms 2.0 para poder llevar a cabo el proceso, esta es la rutina:
De antemano muchas gracias!
Dim objOutlook As New Outlook.Application
Dim objMessage As MailItem
Dim sQueryName As String
Dim MyData As DataObject
Dim records As String
Set objMessage = objOutlook.CreateItem(olMailItem)
Set MyData = New DataObject
'-------------------------------------- AQUI ABRE LA QUERY Y COPIA LOS REGISTROS --------------------------------------
Application.Echo False
sQueryName = "general"
DoCmd.OpenQuery sQueryName, acViewNormal, acReadOnly
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
DoCmd.Close acQuery, sQueryName
Application.Echo True
'-------------------------------------- AQUI ABRE EL CORREO ELECTRONICO --------------------------------------
On Error Resume Next
records = MyData.GetText(1)
With objMessage
.To = "xxxx@xxxxcom"
.Subject = "abcde"
.HTMLBody = records
.Importance = olImportanceHigh
.Display
End With
Set objOutlook = Nothing
Set objMessage = Nothing
DoCmd.SetWarnings True
End Sub
Esta es la situación, tengo una query que genera cierta información y deseo poder enviar esos resultados en el cuerpo del correo en Outlook (.HTMLBody) mediante vba sin tener que exportar y agregarlo como un archivo adjunto.
Puedo hacer que los registros queden en el portapapeles y abrir el correo, sin embargo tengo que presionar CTRL + V para pegar los resultados.
Cabe mencionar que he activado las referencias Microsoft Outlook 12.0 / Microsoft Forms 2.0 para poder llevar a cabo el proceso, esta es la rutina:
De antemano muchas gracias!
Dim objOutlook As New Outlook.Application
Dim objMessage As MailItem
Dim sQueryName As String
Dim MyData As DataObject
Dim records As String
Set objMessage = objOutlook.CreateItem(olMailItem)
Set MyData = New DataObject
'-------------------------------------- AQUI ABRE LA QUERY Y COPIA LOS REGISTROS --------------------------------------
Application.Echo False
sQueryName = "general"
DoCmd.OpenQuery sQueryName, acViewNormal, acReadOnly
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
DoCmd.Close acQuery, sQueryName
Application.Echo True
'-------------------------------------- AQUI ABRE EL CORREO ELECTRONICO --------------------------------------
On Error Resume Next
records = MyData.GetText(1)
With objMessage
.To = "xxxx@xxxxcom"
.Subject = "abcde"
.HTMLBody = records
.Importance = olImportanceHigh
.Display
End With
Set objOutlook = Nothing
Set objMessage = Nothing
DoCmd.SetWarnings True
End Sub
Valora esta pregunta
0