dsd999, 各位老师进来帮我看看代码吧！看看哪里的问题

thlryu

我的目的：
因为每天大量重复发送相近的mail，所以想在OUTLOOK2007里添加1个按钮，实现每次当我发送系统录入状况的时候，只要点击按钮，就可以自动跳出一个Mail模板。稍微经过人工修改后，就可发送。我参考dsd999老师的代码后，写了下面的代码。
我遇到的问题：
1.下面的代码，运行后模板可以自动跳出（display），但是我想要自动加密（encrypt），因为公司有要求这些mail必须加密，为了避免忘掉加密，想用宏自动实现。求各位老师帮忙。。。

                                                     

Private WithEvents vsoCommbandButton As CommandBarButton

Private Sub Application_Startup()

Call addTotalButton

End Sub

Sub addTotalButton()

On Error Resume Next

Dim vsoCommandBar As CommandBar

Set vsoCommandBar = Outlook.ActiveExplorer.CommandBars("AT")

If (vsoCommandBar Is Nothing) Then

Set vsoCommandBar = Outlook.ActiveExplorer.CommandBars.Add("AT", msoBarTop)

Set vsoCommbandButton = vsoCommandBar.Controls.Add(1)

vsoCommbandButton.Caption = "IS录入"

vsoCommbandButton.FaceId = 59

vsoCommbandButton.Style = msoButtonIconAndCaption

vsoCommandBar.Visible = True

End If

End Sub

Private Sub vsoCommbandButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)

Dim ol As New Outlook.Application

Dim ns As Outlook.NameSpace

Dim newMail As Outlook.MailItem

Dim StrMail As String

Dim mDate As Date

Set ns = ol.GetNamespace("MAPI")

Set newMail = ol.CreateItem(olMailItem)

mDate = Format(Now, "yyyy/MM/dd")

StrMail = "<font size=2.5>"

StrMail = StrMail & "<Font Face=Arial>"

StrMail = StrMail & "<Font Color=black><B>Name：</B></font>" & "<Font Color=red>　　　　 　　　　　　XX XX</font><BR><BR>" & _

"<Font Color=black><B>过去数据：</B></font>" & "<Font Color=red>　　　　　 　　有/没有</font><BR><BR>" & _

mDate & "　    　　　　　　AT 录入<BR><BR>"

With newMail

  .Subject = "IS部门AT录入情况"

  .To = "a@ccccom;"

  .CC = "eee@fff.com"

  .HTMLBody = StrMail

.Display

End With

Set newMail = Nothing

Set ns = Nothing

End Sub

thlryu

我自己在网上查过后，添加了一下下面红色的代码，运行没问题，但是加密那个按钮不会自动成为选中状态。。。哪位高手给小弟看看哪里的问题啊。跪谢了。。
                                                     

Private WithEvents vsoCommbandButton As CommandBarButton


Private Sub Application_Startup()

Call addTotalButton

End Sub


Sub addTotalButton()

On Error Resume Next

Dim vsoCommandBar As CommandBar

Set vsoCommandBar = Outlook.ActiveExplorer.CommandBars("AT")

If (vsoCommandBar Is Nothing) Then

Set vsoCommandBar = Outlook.ActiveExplorer.CommandBars.Add("AT", msoBarTop)

Set vsoCommbandButton = vsoCommandBar.Controls.Add(1)

vsoCommbandButton.Caption = "IS录入"

vsoCommbandButton.FaceId = 59

vsoCommbandButton.Style = msoButtonIconAndCaption

vsoCommandBar.Visible = True

End If

End Sub

Private Sub vsoCommbandButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)

Dim ol As New Outlook.Application

Dim ns As Outlook.NameSpace

Dim newMail As Outlook.MailItem

Dim StrMail As String

Dim mDate As Date

Dim OLIns As Outlook.Inspector
Dim OLEnc As Office.CommandBarButton
Dim OLBar As Office.CommandBar

Set ns = ol.GetNamespace("MAPI")

Set newMail = ol.CreateItem(olMailItem)

mDate = Format(Now, "yyyy/MM/dd")

StrMail = "<font size=2.5>"

StrMail = StrMail & "<Font Face=Arial>"

StrMail = StrMail & "<Font Color=black><B>Name：</B></font>" & "<Font Color=red>　　　　 　　　　　　XX XX</font><BR><BR>" & _

"<Font Color=black><B>过去数据：</B></font>" & "<Font Color=red>　　　　　 　　有/没有</font><BR><BR>" & _

mDate & "　    　　　　　　AT 录入<BR><BR>"

With newMail

  .Subject = "IS部门AT录入情况"

  .To = "a@ccccom;"

  .CC = "eee@fff.com"

.HTMLBody = StrMail

  .Display

End With
Set OLIns = newMail.GetInspector
OLIns.Activate
Set OLBar = OLIns.CommandBars("Standard")
Set OLEnc = OLBar.FindControl(, EncryptMsgCtrl)
If Not OLEnc Is Nothing Then
If OLEnc.Enabled = True Then
If OLEnc.State = msoButtonUp Then
OLEnc.Execute
End If
End If
End If
newMail.Display
Set newMail = Nothing

Set ns = Nothing

End Sub

thlryu

自己顶，高手们帮帮忙啊！

dsd999

你这没实现加密效果吧。

dsd999

Set OLEnc = OLBar.FindControl(, 718)

thlryu

已经解决了，谢谢dsd999老师

篮板球

Mark,学习学习.