VBA 根据工作表名称发送邮件

Question

我需要根据工作表名称将 email 从 excel 发送给个人。 如果sheet1名称为raju，则必须作为附件发送至raju@gmail.com，sheet2名称为babu，则必须作为附件发送至babu@gmail.com

我正在尝试编写代码，但卡在我们指定收件人姓名的一行中。 附上下面的代码。

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"

请注意，为 email 设置收件人的推荐方法是使用Recipients.Add方法，该方法在Recipients集合中创建一个新的收件人。 然后您需要调用Resolve方法，该方法尝试根据地址簿解析Recipient object。 例如：

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

在我为技术博客撰写的文章中阅读更多相关信息 - 如何：以编程方式填写 Outlook 中的 TO、CC 和 BCC 字段。