我有一个主表和代码，可根据审阅者姓名将其拆分为单独的表。
我需要根据工作表名称将分割表发送给每个审阅者。
例如：名为 raj 的工作表必须发送到 [email protected]，名为 ravi 的工作表必须发送到 [email protected]。
我找到了通过邮件发送单张纸的代码。
Sub EmailWithOutlook()
Dim oApp As Object
Dim oMail As Object
Dim WB As Workbook
Dim FileName As String
Dim wSht As Worksheet
Dim ShtName As String
Dim CurrDate As String
CurrDate = format(Date, "MM-DD-YY")
Application.ScreenUpdating = False
' Make a copy of the active worksheet
' and save it to a temporary file
Sheets("raj").Activate
ActiveSheet.Copy
Set WB = ActiveWorkbook
FileName = WB.Worksheets(1).Name & " " & CurrDate
On Error Resume Next
Kill "C:\Users\Desktop\workfiles\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:\Users\Desktop\workfiles\" & FileName
'Create and show the Outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
.To = "[email protected]"
'Uncomment the line below to hard code a subject
.Subject = "Subject Line"
'Uncomment the lines below to hard code a body
.body = "Hi Raj" & vbCrLf & vbCrLf & _
"Please find the attached file for work"
.Attachments.Add WB.FullName
.Display
End With
'Delete the temporary file
'WB.ChangeFileAccess Mode:=xlReadOnly
'Kill WB.FullName
'WB.Close SaveChanges:=False
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
如何将所有表格发送给相关人员？
您可以通过以下方式迭代工作簿中的所有工作表，为每个收件人单独撰写电子邮件：
Set oApp = CreateObject("Outlook.Application")
For i = 1 To WB.Sheets.Count
Set oMail = oApp.CreateItem(0)
With oMail
.To = WB.Sheets(i).Name & "@gmail.com"
.Subject = "Subject Line"
'Uncomment the lines below to hard code a body
.body = "Hi Raj" & vbCrLf & vbCrLf & _
"Please find the attached file for work"
.Attachments.Add WB.FullName
.Send
End With
Next i
您可以在我为技术博客撰写的以下文章中阅读更多相关内容：