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

时间:2015-01-23 22:25:20

标签: excel vba excel-vba

Excel vba应用程序中的这个子项已经运行了好几年,在显示要发送的电子邮件(.Display)之前将Outlook签名插入到电子邮件中。这适用于Windows 2007中的Excel 2007和Windows 7中的Excel。

现在,我的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 个答案:

答案 0 :(得分:0)

"我的错误例程中出现错误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 = "ron@debruin.nl"
        .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