根据工作表名称发送邮件

Question

我需要根据工作表名称从 Excel 向个人发送电子邮件。
如果 Sheet1 名称为 raju，则必须将其作为附件发送至 [电子邮件受保护]。
如果sheet2名称是babu，则必须将其作为附件发送至[电子邮件受保护]。

Sub Mail_Every_Worksheet()
  Dim xWs As Worksheet
  Dim xWb As Workbook
  Dim xFileExt As String
  Dim xFileFormatNum As Long
  Dim xTempFilePath As String
  Dim xFileName As String
  Dim xOlApp As Object
  Dim xMailObj As Object
  Dim subj As String
  Dim body As String
  subj = InputBox("enter subject")
  body = InputBox("enter body")
  Dim CurrDate As String
  CurrDate = Format(Date, "MM-DD-YY")
  On Error Resume Next
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  xTempFilePath = Environ$("temp") & "\"
  If Val(Application.Version) < 12 Then
    xFileExt = ".xls": xFileFormatNum = -4143
  Else
    xFileExt = ".xlsm": xFileFormatNum = 52
  End If
  Set xOlApp = CreateObject("Outlook.Application")
  For Each xWs In ThisWorkbook.Worksheets
    If xWs.Name <> "Sheet1" Then
      xWs.Copy
      Set xWb = ActiveWorkbook
      xFileName = xWs.Name & " " & CurrDate
      Set xMailObj = xOlApp.CreateItem(0)
      With xWb
        .SaveAs xTempFilePath & xFileName & xFileExt, FileFormat:=xFileFormatNum
        With xMailObj
        'specify the CC, BCC, Subject, Body below
        
            .To = xWs.Sheets(i).Name & "@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = subj
            .body = body
            .Attachments.Add xWb.FullName
            .Display
        End With
        .Close SaveChanges:=False
      End With
      Set xMailObj = Nothing
      Kill xTempFilePath & xFileName & xFileExt
    End If
  Next
  Set xOlApp = Nothing
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
End Sub

我在这一行遇到错误

.To = xWs.Sheets(i).Name & "@gmail.com"

Answer 1

无需使用

Sheets

属性来获取

Worksheet.Name

属性值。您已经在循环中处理了一个 Worksheet 实例，因此您只需要检索

Name

属性。

Dim xWs As Worksheet
...
For Each xWs In ThisWorkbook.Worksheets
  ...
  .To = xWs.Name & "@gmail.com"

请注意，设置电子邮件收件人的推荐方法是使用

Recipients.Add

方法，该方法会在

Recipients

集合中创建新收件人。然后，您需要调用

Resolve

方法，尝试根据地址簿解析

Recipient

对象。例如：

 Set myRecipient = MyItem.Recipients.Add("Eugene Astafiev")
 myRecipient.Resolve 
 If myRecipient.Resolved Then 
   myItem.Subject = "Test task" 
   myItem.Display 
 End If 

请阅读我为技术博客撰写的文章中的更多信息 - 如何：以编程方式在 Outlook 中填写“收件人”、“抄送”和“密件抄送”字段。