在 Excel 2013 中使用 vba 插入电子邮件签名

Posted 2023-03-27

【中文标题】在 Excel 2013 中使用 vba 插入电子邮件签名

【英文标题】：Inserting email signature using vba in Excel 2013

【发布时间】：2015-03-23 01:44:16

【问题描述】：

这个在 Excel VBA 应用程序中运行良好多年的子程序，在显示电子邮件供我发送 (.Display) 之前将 Outlook 签名插入到电子邮件中。这在 Windows XP 中的 Excel 2007 和 Windows 7 中的 2013 中有效。

现在我有 Windows 8.1 和 Office 2013，在我的错误例程中出现错误 91。参考文献之一可能有问题吗？ - 还是需要对代码进行一些更改？

Sub InsertSig2007(strSigName As String)
 
    Dim objItem As Object
    Dim objInsp As Outlook.Inspector
    ' requires a project reference to the
    ' Microsoft Office library
    Dim objCBP As Office.CommandBarPopup
    Dim objCBP2 As Office.CommandBarPopup
    Dim objCBB As Office.CommandBarButton
    Dim colCBControls As Office.CommandBarControls
    Set objInsp = ActiveInspector
    If Not objInsp Is Nothing Then
        Set objItem = objInsp.CurrentItem
        If objItem.Class = olMail Then
        ' get Insert menu
            Set objCBP = objInsp.CommandBars.ActiveMenuBar.FindControl(, 30005)
            ' get Signature submenu
            Set objCBP2 = objCBP.CommandBar.FindControl(, 5608)
            If Not objCBP2 Is Nothing Then
                Set colCBControls = objCBP2.Controls
                For Each objCBB In colCBControls
                Debug.Print objCBB.Caption
                If objCBB.Caption = strSigName Then
                    objCBB.Execute ' **** see remarks
                    Exit For
                End If
                Next
            End If
        End If
    End If
    Set objInsp = Nothing
    Set objItem = Nothing
    Set colCBControls = Nothing
    Set objCBB = Nothing
    Set objCBP = Nothing
    Set objCBP2 = Nothing
 
End Sub

【问题讨论】：

看起来很脆。它在哪条线上失败了？

【参考方案1】：

“这在我的错误例程中出现错误 91” 调试时不要使用错误例程。这样您就可以看到问题所在，并且可以说出您的问题所在。

应该是

Set objCBP = objInsp.CommandBars.ActiveMenuBar.FindControl(, 30005)

见CommandBars.FindControl Method (Office) “在某些 Microsoft Office 应用程序中使用 CommandBars 已被 Microsoft Office Fluent 用户界面的新功能区组件所取代。”

注意：CommandBars.ExecuteMso Method (Office) 在 2013 年有效，但我认为签名按钮不可用。

您一定会在 Insert Outlook Signature in mail 处找到您的代码的替代品。

可能是这个：

Sub Mail_Outlook_With_Signature_html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
    'Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    'Set OutApp = CreateObject("Outlook.Application")
    'Set OutMail = OutApp.CreateItem(0)

    Set OutMail = CreateItem(0)

    strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
              "<br><br><B>Thank you</B>"

    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"

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

    On Error Resume Next

    With OutMail
        '.To = "[e-mail]"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & Signature
        '.Send    
        'or use 
        .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    'Set OutApp = Nothing
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    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