创建 table 的子集以作为电子邮件附件发送
Create a subset of a table to send as an email attachment
我需要创建一个特定于 table 的子集的 Excel 附件。
随着代码循环遍历每个销售代表（在本例中），他们会收到一封电子邮件，其中在电子邮件正文中包含与他们相关的信息，而且还会收到一份 Excel 电子表格，其中包含相同的信息批量方式，按状态排序。
我想这可以通过创建一个临时 table 或类似的东西并清除它来完成。
这是我的。基本上所有的设置都是为了把它放在带有类别和内容的电子邮件上。
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
通过创建另一个查询来完成此操作，该查询使用记录集中的地区来限制结果，然后附加该查询。
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
我需要创建一个特定于 table 的子集的 Excel 附件。
随着代码循环遍历每个销售代表（在本例中），他们会收到一封电子邮件，其中在电子邮件正文中包含与他们相关的信息，而且还会收到一份 Excel 电子表格，其中包含相同的信息批量方式，按状态排序。
我想这可以通过创建一个临时 table 或类似的东西并清除它来完成。
这是我的。基本上所有的设置都是为了把它放在带有类别和内容的电子邮件上。
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
通过创建另一个查询来完成此操作，该查询使用记录集中的地区来限制结果，然后附加该查询。
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