Отправить несколько записей из MS Access в корпус MS Outlook

Question

Так что мне нужна помощь. Я запускаю данные в MS Access 2013, и у меня есть таблица с несколькими строками и столбцами. То, что я пытаюсь сделать, это взять каждую строку и взять только некоторые из столбцов и отправить данные в MS Outlook и вставить их в тело.

Данные постоянно меняются - это размер. Одна неделя у меня может быть 3 строки данных и несколько недель 50 строк. Так что я ищу из данных заключается в следующем:

MS Access Таблица:

Account Number Date  Time Cust Status  Issue   Corr Action 
123    3/1/16 8A  Open   Customer  Resolved 
345    3/5/16 8:30P Close   Cust. Called Confirmed 

MS Outlook:

Account Number: 123 
Cust Status: Open 
Date: 3/1/16 

Issue: 
Customer 

Corr Action: 
Resolved 

Account Number: 456 
Cust Status: Closed 
Date: 3/5/16 

Issue: 
Cust. Called 

Corr Action: 
Confirmed 

Вот код, который я сделал до сих пор:

Public Sub SendEmail() 
    Dim mailItem As Outlook.mailItem 
    Dim sMsgBody As String 
    Dim aBody() As String 


    Call AdoRecordset 

    InitOutlook 
    Set mailItem = outlookApp.CreateItem(olMailItem) 
     mailItem.To = "" 
     mailItem.CC = "" 
     mailItem.Subject = "Escalations for the week" 

     mailItem.Body = Issues 
     mailItem.Display 

    Set mailItem = Nothing 
    CleanUp 

End Sub 

Private Sub CleanUp() 
    Set outlookNamespace = Nothing 
    Set outlookApp = Nothing 

End Sub 

Function AdoRecordset() 
    Dim rs As New ADODB.Recordset 
    Dim strSql As String 

    strSql = "Select [Issue] From [Table];" 
    rs.Open strSql, CurrentProject.Connection 

    Do While Not rs.EOF 
     Debug.Print rs![Issue] 
     Issues = Issues & rs.Fields(0).Value & vbCrLf 
     rs.MoveNext 
    Loop 

    rs.Close 
    Set rs = Nothing 
End Function 

Answer 1

Вы должны передать отформатированный текст из AdoRecordset в вызывающую подпрограмму.

Public Sub SendEmail() 

    sMsgBody = AdoRecordset() 
    . 
    . 
    . 
    MailItem.Subject = sMsgBody 

End Sub 

Function AdoRecordset() as String 
    Dim rs As New ADODB.Recordset 
    Dim strSql As String 

    strSql = "Select [Account Number], [Date], [Cust Status], [Issue], [Corr Action] From [Table];" 
    rs.Open strSql, CurrentProject.Connection 

    Do While Not rs.EOF 
     For Each oFld In rs.Fields 
      Select Case oFld.Name 
       Case "Account Number", "Date" 
        sResult = sResult & oFld.Name & ":" & oFld.Value & vbCrLf 
       Case "Cust Status" 
        sResult = sResult & oFld.Name & ":" & oFld.Value & vbCrLf & vbCrLf 
       Case Else 
        sResult = sResult & oFld.Name & ":" & vbCrLf & oFld.Value & vbCrLf & vbCrLf 
      End Select 
     Next 
     rs.MoveNext 
    Loop 

    rs.Close 
    Set rs = Nothing 

    AdoRecordset = sResult 
End Function 

Answer 2

*Option Compare Database 
Option Explicit 

Private outlookApp As Outlook.Application 
Private outlookNamespace As Outlook.NameSpace 
Dim Email As String 
Dim Issues As String 

Private Sub InitOutlook() 
    ' Initialize a session in Outlook 
    Set outlookApp = New Outlook.Application 

    'Return a reference to the MAPI layer 
    Set outlookNamespace = outlookApp.GetNamespace("MAPI") 

    'Let the user logon to Outlook with the 
    'Outlook Profile dialog box 
    'and then create a new session 
    outlookNamespace.Logon , , True, False 
End Sub 

Public Sub SendEmail() 
Dim sMsgBody As String 
Dim mailItem As Outlook.mailItem 
Dim sResult As Variant 

    sMsgBody = AdoRecordset() 
    'mailItem.Subject = sMsgBody 
    InitOutlook 
    Set mailItem = outlookApp.CreateItem(olMailItem) 
     mailItem.To = "" 
     mailItem.Subject = "Escalations for the week" 

     mailItem.Body = sResult 
     mailItem.Display 

    Set mailItem = Nothing 
    CleanUp 

End Sub 

Private Sub CleanUp() 
    Set outlookNamespace = Nothing 
    Set outlookApp = Nothing 

End Sub 

Function AdoRecordset() As String 
    Dim rs As New ADODB.Recordset 
    Dim strSql As String 
    Dim oFld As Variant 
    Dim sResult As Variant 

    strSql = "Select [Account Number], [Dates], [Cust Status], [Issue], [Corr Action] From [Table];" 
    rs.Open strSql, CurrentProject.Connection 

    Do While Not rs.EOF 
     For Each oFld In rs.Fields 
      Select Case oFld.Name 
       Case "Incident#", "Date Escalted" 
        sResult = sResult & oFld.Name & ":" & oFld.Value & vbCrLf 
       Case "Customer Status" 
        sResult = sResult & oFld.Name & ":" & oFld.Value & vbCrLf & vbCrLf 
       Case Else 
        sResult = sResult & oFld.Name & ":" & vbCrLf & oFld.Value & vbCrLf & vbCrLf 
      End Select 
     Next 
     rs.MoveNext 
    Loop 

    rs.Close 
    Set rs = Nothing 

    AdoRecordset = sResult 
End Function* 

Answer 3

К сожалению, это то, что у меня есть. Ты можешь починить это.

Option Compare Database 
Option Explicit 

Private outlookApp As Outlook.Application 
Private outlookNamespace As Outlook.NameSpace 
Dim Email As String 
Dim Issues As String 

Private Sub InitOutlook() 
    ' Initialize a session in Outlook 
    Set outlookApp = New Outlook.Application 

    'Return a reference to the MAPI layer 
    Set outlookNamespace = outlookApp.GetNamespace("MAPI") 

    'Let the user logon to Outlook with the 
    'Outlook Profile dialog box 
    'and then create a new session 
    outlookNamespace.Logon , , True, False 
End Sub 

Public Sub SendEmail() 
Dim sMsgBody As String 
Dim mailItem As Outlook.mailItem 
Dim sResult As Variant 

    sMsgBody = AdoRecordset() 
    'mailItem.Subject = sMsgBody 
    InitOutlook 
    Set mailItem = outlookApp.CreateItem(olMailItem) 
     mailItem.To = "" 
     mailItem.Subject = "Escalations for the week" 

     mailItem.Body = sResult 
     mailItem.Display 

    Set mailItem = Nothing 
    CleanUp 

End Sub 

Private Sub CleanUp() 
    Set outlookNamespace = Nothing 
    Set outlookApp = Nothing 

End Sub 

Function AdoRecordset() As String 
    Dim rs As New ADODB.Recordset 
    Dim strSql As String 
    Dim oFld As Variant 
    Dim sResult As Variant 

    strSql = "Select [Account Number], [Dates], [Cust Status], [Issue], [Corr Action] From [Table];" 
    rs.Open strSql, CurrentProject.Connection 

    Do While Not rs.EOF 
     For Each oFld In rs.Fields 
      Select Case oFld.Name 
       Case "Account Number", "Dates" 
        sResult = sResult & oFld.Name & ":" & oFld.Value & vbCrLf 
       Case "Cust Status" 
        sResult = sResult & oFld.Name & ":" & oFld.Value & vbCrLf & vbCrLf 
       Case Else 
        sResult = sResult & oFld.Name & ":" & vbCrLf & oFld.Value & vbCrLf & vbCrLf 
      End Select 
     Next 
     rs.MoveNext 
    Loop 

    rs.Close 
    Set rs = Nothing 

    AdoRecordset = sResult 
End Function