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
答案 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