Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Outlook VBA-来自excel的电子邮件_Vba_Excel_Outlook - Fatal编程技术网

Outlook VBA-来自excel的电子邮件

Outlook VBA-来自excel的电子邮件,vba,excel,outlook,Vba,Excel,Outlook,我已经创建了以下代码,但我无法调用签名。我正在寻找呼叫邮件之前,以便我可以得到默认的签名,或者如果有人可以建议一个解决办法。我是VBA新手,无法找到解决方案。先谢谢你 Sub Email() Dim OutApp As Object Dim OutMail As Object Dim strbody, SigString, signature As String Dim MailAttachments As String Dim cell As Variant

我已经创建了以下代码,但我无法调用签名。我正在寻找呼叫邮件之前,以便我可以得到默认的签名,或者如果有人可以建议一个解决办法。我是VBA新手,无法找到解决方案。先谢谢你

Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody, SigString, signature As String
Dim MailAttachments As String
Dim cell As Variant                                 'Not previously DIM'd
Dim GetBoiler As Object

Sheets("List").Select                               'Edit as required
Range("A2").Select

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
For Each cell In Columns("C").Cells
    If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, "D").Value) = "yes" Then

        With Application.ActiveSheet
            MailAttachments = Cells(cell.Row, "E").Value
        End With
        Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail

                .To = cell.Value
                .Subject = "Monthly Review Meeting with Professional Direct Support for Microsoft Azure – " & Cells(cell.Row, "A").Value  'Refer value from column A (company name)
                .HTMLBody = "" & _
                "<style> body{color:black;font-family:Calibri;font-size: 11pt;}" & "<HTML><body>" & "<p>" & "Hello " & Cells(cell.Row, "B") & ", " & "<br>" & "</br>" & "<br>" & "I am the delivery manager associated to " & "<b>" & Cells(cell.Row, "A") & "</b>" & "<br>" & "</br>" _
                '.Attachments.Add MailAttachments
                .Display
                'Or use .Send

            End With
                SigString = Environ("appdata") & " Roaming\Microsoft\Signatures\Sign.htm"
                If Dir(SigString) <> "" Then
                    signature = GetBoiler(SigString)
                Else
                    signature = ""

                End If

            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing

    End If
Next
cleanup:
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
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`
Sub-Email()
Dim OutApp作为对象
将邮件变暗为对象
Dim strbody、SigString、签名为字符串
将邮件附件设置为字符串
变暗单元格为“以前未变暗”
以锅炉为对象
工作表(“列表”)。选择“根据需要编辑”
范围(“A2”)。选择
Application.ScreenUpdating=False
Set-OutApp=CreateObject(“Outlook.Application”)
Set-OutMail=OutApp.CreateItem(0)
对于列(“C”)中的每个单元格。单元格
如果单元格值像“*@*。?*”和_
LCase(Cells(cell.Row,“D”).Value)=然后是
使用Application.ActiveSheet
MailAttachments=单元格(cell.Row,“E”).值
以
Set-OutMail=OutApp.CreateItem(0)
出错时继续下一步
发邮件
.To=单元格.Value
.Subject=“Microsoft Azure专业直接支持的月度审查会议–”&Cells(cell.Row,“A”)。Value“指A列(公司名称)中的值
.HTMLBody=”“&_
“body{color:black;font-family:Calibri;font-size:11pt;}”和“&”&”&“&”&”和“Hello”&单元格(cell.Row,“B”)&“&”&“&
”和“&”
”和“&”单元格(cell.Row,“A”)和“&
”和“
”关联的传递经理_ '.Attachments.Add邮件附件 .展示 '或使用。发送 以 SigString=Environ(“appdata”)和“Roaming\Microsoft\Signatures\Sign.htm” 如果Dir(SigString)“,则 signature=GetBoiler(SigString) 其他的 signature=“” 如果结束 错误转到0 发送邮件=无 设置应用程序=无 如果结束 下一个 清理: 发送邮件=无 设置应用程序=无 Application.ScreenUpdating=True 端接头 函数GetBoiler(ByVal sFile作为字符串)作为字符串 作为对象的Dim fso 将T作为对象 设置fso=CreateObject(“Scripting.FileSystemObject”) 设置ts=fso.GetFile(sFile).OpenAsTextStream(1,-2) GetBoiler=ts.ReadAll 关闭 端函数`
到目前为止,代码看起来不错。不过,让我提出一个更简单的方法来获得签名。当有人打开新电子邮件时,默认情况下会显示签名。因此,如果我们强制显示电子邮件,那么我们可以保存html正文(包含签名),以便以后插入

.With OutMail  
.Display   
t = .HTMLBody
然后,当你想编辑你的.HTMLBody时,你可以放

.HTMLBody = "something something blah blah" & "<br/>" & t
.HTMLBody=“something something blah blah”&

FYI
Dim strobdy,SigString,signature As String
signature
声明为
String
,并且
strobdy
SigString
都是隐式
变体。所有变量都需要显式类型。因此,在单独的
Dim
指令中声明它们,或者将
Dim strbody作为字符串,SigString作为字符串,签名作为字符串
。另外,
单元格
应为
范围
。如果在下一次错误恢复时删除
,您是否会收到任何实际错误?FWIW OERN通常是处理运行时错误最糟糕的方法;它隐藏了真正的问题,使bug更难找到。我也建议您在列(“C”)中的每个单元格中重新考虑“代码>”。Cys<代码>处理1048576个单元格(假设您使用的是Excel的版本,比最近的版本多2003),请考虑在范围(C1)、单元格(ROWSCOUNT,C))中使用诸如“代码>”之类的东西。.Cells
对于Intersect(列(“C”)、ActiveSheet.UsedRange.Cells中的每个单元格。Cells
。在
电子邮件
过程中,将变量
声明为对象。稍后,您会看到一条语句,它说
signature=GetBoiler(SigString)
,它正在使用该对象。但是你在任何地方都无法创建对象。我怀疑您打算使用张贴代码底部的
GetBoiler
过程,因此,如果是这样,请删除阻止您访问该函数的
Dim GetBoiler As Object
。(人们可能会注意到,早些时候,如果您在问题中包含您收到的任何错误消息以及错误发生在哪一行。)啊哈-我道歉-@Mat'sMug提到您有一个隐藏该错误的方法,因此我假设这意味着您很高兴该
signature=GetBoiler(SigString)
行不起作用。