Hi all, I have searched the forum looking for my answer, but can not find it... Hoping somepne can help. I have a some data in a table, that I want to email to the recipients but have the data in the table appear in the body of the actual email vs. as an attachment. My email code in VB works great.. I will attach below. I can do this with a .txt file, where the txt file is read, and inserted into the email body, but when output the table as a txt, it loses all formatting/positioning (Which makes sense). I can keep the table of data as a Table, or make a it a report if that will work...
basically I am just trying to get the contents of my table to appear in the email body, in somewhat of a table/aligned format.. I am also attaching an xls file, but that is unrelated. In my current method I am using a macro to convert the table to an outputted txt file,.
The table that I with to appear in the body of my email is called TBL_HUNGARY_SDR_ALL_ENG, and I output it to a txt file called Hungary_SDR_report.txt
code
_______
Public Function ModuleHungarySDR()
Dim db As DAO.Database
Dim blRet As Boolean
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim rst1 As DAO.Recordset
Dim strSQL As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strSQL4 As String
Dim strSQL5 As String
Dim strSQL6 As String
Dim strSQL7 As String
Dim strSQL8 As String
Dim strSQL9 As String
Dim strSQL10 As String
Dim strSQL11 As String
Dim strSQL12 As String
Dim strSQL13 As String
Dim strSQL14 As String
Dim strSQL15 As String
Dim stDocName As String
stDocName = "Hungary_SDR_Report"
DoCmd.SetWarnings False
'Delete Batch tables if they exist
On Error Resume Next
DoCmd.OpenQuery "HHH_Hungary_All_Open_SDR_IR_delete"
DoCmd.OpenQuery "HHH_Hungary_All_Open_SDR"
DoCmd.OpenQuery "HHH_Hungary_All_Open_SDR_IR"
DoCmd.RunMacro "OutPutHungaryEmail"
On Error GoTo 0
DoCmd.TransferSpreadsheet acExport, 8, "TBL_HUNGARY_SDR_ALL_ENG", "D:\HUNGARY_SDR.xls", True, ""
DoCmd.TransferSpreadsheet acExport, 8, "TBL_HUNGARY_SDR_ALL", "D:\HUNGARY_SDR.xls", True, ""
'Email
Set fso = New FileSystemObject
BodyFile$ = "D:\Hungary_SDR_report.txt"
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Function
End If
' Since we got a file, we can open it up.
Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)
' and read it into a variable.
MyBodyText = MyBody.ReadAll
' and close the file.
MyBody.Close
Dim iMsg, iConf, Flds, i As Long
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "NYSCHX06PSGE.sch.ge.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
'To send the selection use this example (is only working if the sheet is unprotected)
With iMsg
Set .Configuration = iConf
.To = "Mark.Taft@ge.com"
.CC = ""
.BCC = ""
.FROM = "~eSMS_Automated_Reports@ge.com"
'Were there errors?
.Subject = "HUNGARY OPEN SDR IN CLEAR ORBIT"
.textbody = MyBodyText
.AddAttachment "d:\HUNGARY_SDR.xls"
'.AddAttachment "c:\" & rst1.Fields("Last Name") & ".xls"
' If Not IsMissing(ColATT) Then
' If ColATT.Count >= 0 Then
' For i = 1 To ColATT.Count
' .AddAttachment ColATT(i)
' Next i
' End If
'End If
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
'MyOutlook.Quit
'Set MyOutlook = Nothing
DoCmd.SetWarnings False
End Function