我想将一个工作簿中的多个工作表(例如Sheet71,Sheet76,Sheet60和Sheet77)复制到另一工作簿中,以将电子邮件发送给我在工作表上的电子邮件密钥表中概述的收件人71。
这些电子邮件将发送给个人,以概述他们的奖金。
因此,至关重要的是,接收者只能接收自己的或负责的人。
我已经找到了如何将一个工作表发送给一个收件人的方法,但是在不使用工作表上的名称(皮尔斯集团矩阵,舒夫矩阵,赌博矩阵和里德矩阵)的情况下,无法弄清楚如何使用多个工作表来完成此任务相对于VBA中的Sheet71,Sheet76,Sheet60和Sheet77。
我需要能够在宏中引用工作表编号而不是名称,因为确实发生了周转。
下面是我编写的用于向一个工作表的电子邮件密钥表(Sheet81)中的一个人发送电子邮件的代码,但仅发送工作表71。
我尝试使用Array关键字和其他多个关键字,但似乎无法使其正常工作。
我需要引用工作表编号而不是工作表名称,因为替换人员时名称会更改。
我希望像下面的代码一样进行复制,但是我愿意尝试使用Select命令(如果可行)。
Sub Mail()
Dim OutlookApp As Object
Dim Mess As Object, Recip
Recip = Sheet81.[C35].Value
newDate = MonthName(Month(DateAdd("m", -1, Date)), False)
' Make a copy of the active worksheet
' and save it to a temporary file
Sheet71.Copy
Set WB = ActiveWorkbook
Filename = WB.Worksheets(1).Name
On Error Resume Next
Kill "C:\" & Filename
On Error GoTo 0
WB.SaveAs Filename:="C:\" & Filename
Set OutlookApp = CreateObject("Outlook.Application")
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Subject = (newDate + " Matrix")
.Body = ("Attached is your " + newDate + " bonus matrix. Thanks! Neil")
.to = Recip
.Attachments.Add WB.FullName
.Display
.Send
End With
ActiveWorkbook.Close
Set OutlookApp = Nothing
Set Mess = Nothing
End Sub
答案 0 :(得分:0)
在这种方法中,我选择创建一个名为sendMultMails
的新子例程。这将创建您选择添加的工作表的集合。由于您不想使用工作表名称作为参考,因此我使用工作表的CodeName。
因此,将工作表添加到集合中并循环该集合。在循环中,您将调用其他例程Mail
,并将工作表作为参数传递。
Sub sendMultMails()
Dim wsColl As New Collection, ws As Worksheet
Rem: Add your worksheets to the collection via the worksheet's CodeName
With wsColl
.Add Sheet71
.Add Sheet76
.Add Sheet60
.Add Sheet77
End With
Rem: loop through each collection item, calling the Mail Routine
For Each ws In wsColl
Mail ws
Next
End Sub
Rem: Added an argument for you to pass the ws obj to this routine
Sub Mail(ws As Worksheet)
Dim OutlookApp As Object
Dim Mess As Object, Recip
Recip = ws.Range("C35").Value
newDate = MonthName(Month(DateAdd("m", -1, Date)), False)
' Make a copy of the active worksheet
' and save it to a temporary file
ws.Copy
Set WB = ActiveWorkbook
Filename = WB.Worksheets(1).Name
On Error Resume Next
Kill "C:\" & Filename
On Error GoTo 0
WB.SaveAs Filename:="C:\" & Filename
Set OutlookApp = CreateObject("Outlook.Application")
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Subject = (newDate + " Matrix")
.Body = ("Attached is your " + newDate + " bonus matrix. Thanks! Neil")
.to = Recip
.Attachments.Add WB.FullName
.Display
.Send
End With
ActiveWorkbook.Close
Set OutlookApp = Nothing
Set Mess = Nothing
End Sub
答案 1 :(得分:0)
您可以使用WB.Worksheets(1).CodeName
来引用工作表编号。
CodeName属性为只读 您可以将特定工作表称为Worksheets(“ Fred”)。Range(“ A1”),其中Fred是.Name属性,也可以作为Sheet1.Range(“ A1”),其中Sheet1是工作表的代号。
有关更多信息,您可以参考以下链接: