VBA Outlook 发邮件，带签名

steven38550

各位大师

下面的VBA是，我需要用outlook群发的带附件的程序（套用的），我需要在每一份邮件里添加固定格式的签名，签名的的存储位置是：C:\Users\Steven\AppData\Roaming\Microsoft\Signatures\replay.htm
replay.rar (4 KB, 下载次数: 16)

2018-4-11 15:00 上传

点击文件名下载附件

所以请大师们帮帮忙，如何把这个加进去，非常感谢！！！

Sub sendemail()

    Dim myOlApp As Object
    Dim myitem As Object
    Dim i As Integer, j As Integer
    Dim strg As String
    Dim atts As Object
    Dim mycc As Object
    Dim myfile As String



    Set myOlApp = CreateObject("Outlook.Application")

    With Sheets("Sheet1")
        i = 2

        Do While .Cells(i, 2) <> ""
            Set myitem = myOlApp.CreateItem(0)
           Set atts = myitem.Attachments
            myitem.To = .Cells(i, 2)              '收件人E-mail
            myitem.Subject = .Cells(i, 3)            '标题
            myitem.Body = "Hi." & .Cells(i, 1) & vbNewLine & vbNewLine & vbNewLine & .Cells(i, 4)    '正文
            Dim name As String
            name = .Cells(i, 1)
            If name = "Simon" Then
                myfile = Dir(ThisWorkbook.Path & "\1186" & .Cells(i, 1) & "*.*")
            ElseIf name = "Simon.li" Then
                myfile = Dir(ThisWorkbook.Path & "\1035" & .Cells(i, 1) & "*.*")
            Else
                myfile = Dir(ThisWorkbook.Path & "\*" & .Cells(i, 1) & "*.*")
            End If
            Do Until myfile = ""
                myitem.Attachments.Add ThisWorkbook.Path & "\" & myfile, 1
                myfile = Dir
            Loop
            myitem.display '预览，如果想直接发送，把.display改为.send

            i = i + 1
            strg = ""
        Loop
    End With
    Set myitem = Nothing
End Sub

steven38550

？？？？？？

steven38550

上传这个要改的文件附件
名单.rar (20.46 KB, 下载次数: 3)

2018-4-13 11:23 上传

点击文件名下载附件