创建要作为电子邮件附件发送的表子集

Question

我需要创建一个特定于表子集的 Excel 附件。

当代码遍历每个销售代表（在本例中）时，他们将在电子邮件正文中收到一封包含与他们相关的信息的电子邮件，但也会收到一个 Excel 电子表格，其中包含以批量方式包含的相同信息，按状态排序。

我认为这将通过创建一个临时表或类似的东西并将其清除来完成。

这是我所拥有的。基本上一切都设置为将其放在带有类别和东西的电子邮件中。

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 = "[e-mail]"
'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 = "[e-mail]"
            '.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 = "[e-mail]"
    '.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 = "[e-mail]"

'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 = "[e-mail]"
            '.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 = "[e-mail]"
    '.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