访问VB - 临时表创建和电子邮件附件

Question

我需要创建一个特定于我正在使用的表的子集的excel附件。所以，当代码循环遍历每个销售代表（在这种情况下）时，他们需要在下面格式化的电子邮件正文中发送一封包含与他们相关信息的电子邮件，同时还需要包含相同信息的excel电子表格批量处理，按状态排序。

我认为这必须通过创建一个临时表或类似的东西并清除它来完成，但我有点迷失在我会放置类似的东西，甚至它最终会看到什么喜欢。

这是我到目前为止所拥有的。基本上所有设置都将其放在带有类别和内容的电子邮件中。我认为它最终会转换为HTML，但这既不是在这里也不是在那里。无论如何，提前谢谢：

Function SendNotification()
Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset
Dim db As Database
Dim sql, sMsg, sPrevTerritory, sPrevEmail, sCurrentTerritory, sPrevRep, sCurrentRep, sKrullj1, sImgPath, sTherapy As String
Dim iNotRecieved, iCompleted, iWorksheetGenerated, iReconciled As Integer

iNotRecieved = 0
iCompleted = 0
iWorksheetGenerated = 0
iReconciled = 0
sKrullj1 = "john.m.krull@placeofemployment.com"


'Set Outlook Variables
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Set db = CurrentDb
sql = "select * from [MT + Emails] Order By Territory,[Status] desc where Therapy = 'Peripheral' and [Loc Type] = 'Account'"
Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)

sPrevTerritory = rs!Territory
sPrevRep = rs![Employee Name]
sPrevEmail = Nz(rs![Employee Email Address], GetUserName() & "@placeofemployment.com")
sTherapy = rs!Therapy

sMsg = "Hello," & vbLf & vbLf & "Here is an update on your Cycle Count(s)." & vbLf & vbLf

Do While Not rs.EOF

    If sPrevTerritory <> rs!Territory Then
        sMsg = sMsg & "Regards," & vbLf & vbLf & "Customer Care"

        With OutMail
            .To = sPrevEmail
            '.To = sKrullj1
            .BCC = GetUserName() & "@placeofemployment.com"
            .Sentonbehalfofname = "Is10amTooEarlyForLunch@placeofemployment.com"
            '.Subject = "Cycle Count Update"
            .Subject = "Cycle Count Update - " & sPrevTerritory & "" & sPrevRep
            .Body = sMsg
            .Send
            '.Display
        End With

        sMsg = "Hello," & vbLf & vbLf & "Here is an update on your Cycle Count(s)." & vbLf & vbLf
        sPrevEmail = Nz(rs![Employee Email Address], GetUserName() & "@placeofemployment.com")
        sPrevTerritory = rs!Territory
        sPrevRep = rs![Employee Name]
        iNotRecieved = 0
        iCompleted = 0
        iWorksheetGenerated = 0
        iReconciled = 0

    End If

    sCurrentEmail = Nz(rs![Employee Email Address], GetUserName() & "@placeofemployment.com")
    If rs![Status] = "Not Recieved" And iNotRecieved = 0 Then
        iNotRecieved = 1
        sMsg = sMsg & "The following Cycle Count (s) have not been received:" & vbLf & vbLf
    ElseIf rs![Status] = "Completed" And iCompleted = 0 Then
        iCompleted = 1
        sMsg = sMsg & "The following Cycle Count(s) have been completed:" & vbLf & vbLf
    ElseIf rs![Status] = "Worksheet Generated" And iWorksheetGenerated = 0 Then
        iWorksheetGenerated = 1
        sMsg = sMsg & "The following Cycle Count(s) have been receieved and are pending reconciliation:" & vbLf & vbLf
    ElseIf rs![Status] = "Reconcilied - Pending SAP Processing" And iReconciled = 0 Then
        iReconciled = 1
        sMsg = sMsg & "The following Cycle Count(s) have been recieved, reconciled, and are pending SAP processing:" & vbLf & vbLf
    End If

    sMsg = sMsg & vbTab & "Status: " & rs![Status] & vbLf _
         & vbTab & "Location: " & rs![Location] & vbLf _
         & vbTab & "Location Name: " & rs![Location Name] & vbLf _
         & vbTab & "Territory: " & rs![Territory Name] & vbLf _
         & vbTab & "District: " & rs![District Name] & vbLf _
         & vbTab & "CC Master ID: " & rs![ID] & vbLf & vbLf _

    rs.MoveNext

Loop


sMsg = sMsg & "Regards," & vbLf & vbLf & "Customer Care"

With OutMail
    .To = sPrevEmail
    '.To = sKrullj1
    .BCC = GetUserName() & "@placeofemployment.com"
    .Sentonbehalfofname = "ImStarving@shouldhaveeatenbreakfast.com"
    '.Subject = "Cycle Count Update"
    .Subject = "Cycle Count Update - " & sPrevTerritory & "" & sRep
    .Body = sMsg
    .Send
    '.Display


End With

' Reset Outlook variables
Set OutMail = Nothing
Set OutApp = Nothing

End Function

Answer 1

这是通过创建另一个查询来使用记录集中的区域来限制结果，然后附加它。

Function SendNotificationNVA()
Dim OutApp As Object
Dim OutMail As Object
Dim rs As DAO.Recordset
Dim db As Database
Dim sql, sMsg, sPrevTerritory, sPrevEmail, sTerritory, sPrevTName, sTName, sKrullj1, sImgPath, sTherapy, sLocType As String
Dim iNotRecieved, iCompleted, iWorksheetGenerated, iReconciled As Integer
Dim sFileName, sQuery, sExportFile, sTempFilePath, sCurrentEmail, sEndDate As String

iNotRecieved = 0
iCompleted = 0
iWorksheetGenerated = 0
iReconciled = 0
sKrullj1 = "john.m.krull@job.com"


'Set Outlook Variables
Set OutApp = CreateObject("Outlook.Application")

Set db = CurrentDb
sql = "select * from [Pending CC Notification Recipients - NVA] Order By Territory"
Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)

sPrevTerritory = rs!Territory
sPrevTName = rs![Territory Name]
sLocType = rs![Loc Type]
sTherapy = rs!Therapy
sPrevEmail = Nz(rs![Employee Email Address], GetUserName() & "@job.com")
sTerritory = rs!Territory
sTName = rs![Territory Name]
sEndDate = rs![End Date]

sMsg = "Hello," & vbLf & vbLf & "Here is an update on your Cycle Count(s)." & vbLf & vbLf

Do While Not rs.EOF

    If sPrevTerritory <> rs!Territory Then

    sTempFilePath = Environ$("temp") & "\"

    ' Setup parameters for export
        sql = "Delete * From [Pending CC Notification Parameter]"
        DoCmd.RunSQL sql
        sql = "Insert Into [Pending CC Notification Parameter] ([Therapy],[Loc Type],[Territory],[Territory Name]) " _
            & "VALUES ('" & sTherapy & "','" & sLocType & "','" & sTerritory & "', '" & sTName & "')"
        DoCmd.RunSQL sql

    ' Export data to attachment
        sFileName = sTName & " " & sTherapy
        sQuery = "MT + Emails"
        sExportFile = sTempFilePath & sFileName & ".xlsx"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "MT + Emails", _
            sTempFilePath & sFileName & ".xlsx", True

        sMsg = sMsg & "Regards," & vbLf & vbLf & "Customer Care"

    Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = sPrevEmail
            '.To = sKrullj1
            .BCC = GetUserName() & "@job.com"
            .Sentonbehalfofname = "rs@job.com"
            '.Subject = "Cycle Count Update"
            .Subject = "Cycle Count Update - " & sTName & " " & sTherapy & " " & sLocType
            .Body = sMsg
            .Attachments.Add sTempFilePath & sFileName & ".xlsx"
            '.Send
            .Display
        End With

    ' Delete temp file
        If (Dir(sTempFilePath & sFileName & ".xlsx") <> "") Then
            Kill sTempFilePath & sFileName & ".xlsx"
        End If

        sMsg = "Hello," & vbLf & vbLf & "Here is an update on your Cycle Count(s)." & vbLf & vbLf
        sPrevEmail = Nz(rs![Employee Email Address], GetUserName() & "@job.com")
        sPrevTerritory = rs!Territory
        iNotRecieved = 0
        iCompleted = 0
        iWorksheetGenerated = 0
        iReconciled = 0

    End If

    sCurrentEmail = Nz(rs![Employee Email Address], GetUserName() & "@job.com")
    If rs![Status] = "Not Recieved" And iNotRecieved = 0 Then
        iNotRecieved = 1
        sMsg = sMsg & "The following Cycle Count (s) have not been received:" & vbLf & vbLf
    End If

    sMsg = sMsg & vbTab & "Status: " & rs![Status] & vbLf _
         & vbTab & "Location: " & rs![Loc Number] & vbLf _
         & vbTab & "Location Type: " & rs![Loc Type] & vbLf _
         & vbTab & "Location Name: " & rs![Loc Name] & vbLf _
         & vbTab & "Territory Name: " & rs![Territory Name] & vbLf _
         & vbTab & "District Name: " & rs![District Name] & vbLf _
         & vbTab & "ID: " & rs![ID] & vbLf & vbLf _

    sTerritory = rs!Territory
    sTName = rs![Territory Name]

    rs.MoveNext

Loop


sMsg = sMsg & "Regards," & vbLf & vbLf & "Customer Care"

    sTempFilePath = Environ$("temp") & "\"

    ' Setup parameters for export
        sql = "Delete * From [Pending CC Notification Parameter]"
        DoCmd.RunSQL sql
        sql = "Insert Into [Pending CC Notification Parameter] ([Therapy],[Loc Type],[Territory],[Territory Name]) " _
            & "VALUES ('" & sTherapy & "','" & sLocType & "','" & sTerritory & "', '" & sTName & "')"
        DoCmd.RunSQL sql

    ' Export data to attachment
        sFileName = sTName & " " & sTherapy
        sQuery = "MT + Emails"
        sExportFile = sTempFilePath & sFileName & ".xlsx"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "MT + Emails", _
            sTempFilePath & sFileName & ".xlsx", True

Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = sPrevEmail
    '.To = sKrullj1
    .BCC = GetUserName() & "@job.com"
    .Sentonbehalfofname = "rs@job.com"
    '.Subject = "Cycle Count Update"
    .Subject = "Cycle Count Update - " & sTName & " " & sTherapy & " " & sLocType
    .Body = sMsg
    .Attachments.Add sTempFilePath & sFileName & ".xlsx"
    '.Send
    .Display

End With

    ' Delete temp file
        If (Dir(sTempFilePath & sFileName & ".xlsx") <> "") Then
            Kill sTempFilePath & sFileName & ".xlsx"
        End If

' Reset Outlook variables
Set OutMail = Nothing
Set OutApp = Nothing

End Function