使用Outlook签名将工作簿中的不同工作表发送到不同的电子邮件+ CC

时间:2014-02-24 19:44:32

标签: excel vba excel-vba outlook

我在工作簿中的每个工作表上都收到了大量电子邮件,我想将工作表与主题,邮件正文和签名的正文一起发送到工作表上的电子邮件地址。

主题工作正常,但邮件和签名的正文却没有。 以下是我的VBA代码。 拜托,我真的需要你的帮助。 非常感谢。

Sub Mail_every_Worksheet()
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
    On Error Resume Next
        If sh.Range("g1").Value Like "*@*" Then
            sh.Copy
            ActiveWorkbook.SaveAs sh.Name, 56
            ActiveWorkbook.SendMail ActiveSheet.Range("g1").Value, _
                sh.Name & " Data"

            Kill ActiveWorkbook.FullName
            ActiveWorkbook.Close False
        End If
    Next sh
    Application.ScreenUpdating = True
    Application.DisplayAlert = False
End Sub

拜托,我真的需要你的帮助。 非常感谢。

2 个答案:

答案 0 :(得分:0)

猜猜你在寻找什么(如果你正在使用OUTLOOK):

Sub Mail_every_Worksheet()
Dim sh As Worksheet
Set Oapp = CreateObject("outlook.application")
Set itm = Oapp.createitem(0)

SigString = Environ("username") & "\Microsoft\Signatures\XXXX.htm" ' this is where your Outlook signture being saved, yours might be different from my path

If Dir(SigString) <> "" Then
    Signt = GetBoiler(SigString)
Else
    Signt = ""
End If

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
On Error Resume Next
    If sh.Range("g1").Value Like "*@*" Then
        sh.Copy
        ActiveWorkbook.SaveAs sh.Name, 56
        With itm
        .Subject = sh.Name & " Data"
        .to = ActiveSheet.Range("g1").Value
        .cc = "your cc email address"
        .body = "here is the body" & Signt
        .Attachments.Add (sh.Name & ".xls")
        .send
        End With

        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
    End If
Next sh
Application.ScreenUpdating = True
Application.DisplayAlert = False
End Sub

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

我不确定您是否需要附件,并且每次发现要发送的电子邮件时都需要使用其他名称保存工作簿

答案 1 :(得分:0)

如果Alex的答案对你不起作用,那么一个不那么优雅的解决方案就是使用工作簿录制宏并按照你要做的去做。查看宏的vba代码并进行必要的调整以使其自动化。