斑竹：请稍作讲解

FENGJUN

Sub ToggleDays() Dim objOL As Outlook.Application Dim objExpl As Outlook.Explorer Dim objCBB As Office.CommandBarButton Const cbbOneDayID = 1094 Const cbbFiveDaysID = 5556 On Error Resume Next

Set objOL = CreateObject("Outlook.Application") Set objExpl = objOL.ActiveExplorer If objExpl.CurrentFolder.DefaultItemType = olAppointmentItem Then Set objCBB = objExpl.CommandBars.FindControl(, cbbOneDayID) If objCBB.State = msoButtonDown Then Set objCBB = objExpl.CommandBars.FindControl(, cbbFiveDaysID) objCBB.Execute Else objCBB.Execute End If End If Set objOL = Nothing Set objExpl = Nothing Set objCBB = Nothing End Sub

'--------------------------------------------------------------------------------------------

Sub GoToFindContacts() Dim objOL As Outlook.Application Dim objNS As Outlook.NameSpace Dim objContacts As Outlook.MAPIFolder Dim objExpl As Outlook.Explorer Dim colCB As Office.CommandBars Dim objFindCBB As Office.CommandBarButton Set objOL = CreateObject("Outlook.Application") Set objNS = objOL.GetNamespace("MAPI") ' display contacts as active folder Set objExpl = objOL.ActiveExplorer Set objContacts = objNS.GetDefaultFolder(olFolderContacts) Set objExpl.CurrentFolder = objContacts ' get Find button, check its state and execute if not already active Set colCB = objExpl.CommandBars Set objFindCBB = colCB.FindControl(, 5592) With objFindCBB If .State = msoButtonUp Then .Execute End If End With Set objOL = Nothing Set objNS = Nothing Set objContacts = Nothing Set colCB = Nothing Set objFindCB = Nothing Set objExpl = Nothing End Sub

'-------------------------------------------------------------------------------------

' use this procedure to test the routine ' substitute the name of whatever stationery you want to use Sub LaunchNotebookMessage() Dim strStatName As String strStatName = "Notebook" Call CreateStationeryMessage(strStatName) End Sub

Sub CreateStationeryMessage(strName As String) Dim objCB As Object Dim objCBB As Object ' Office.CommandBarButton Set objCB = Application.ActiveExplorer.CommandBars.FindControl(, 31146) If Not objCB Is Nothing Then ' Set objCBStat = objCB.Controls.Item(strName) ' didn't work For Each objCBB In objCB.Controls If objCBB.Caption = strName Then objCBB.Execute Exit For End If Next End If Set objCB = Nothing Set objCBB = Nothing End Sub

'-------------------------------------------------------------------------------------

Public Sub SendNow() Dim oApp As Outlook.Application Dim oCtl As Office.CommandBarControl Dim oPop As Office.CommandBarPopup Dim oCB As Office.CommandBar Dim oNS As Outlook.NameSpace Dim oItem As Object

'First find and send the current item to the Outbox Set oApp = CreateObject("Outlook.Application") Set oNS = oApp.GetNamespace("MAPI") Set oItem = oApp.ActiveInspector.CurrentItem On Error Resume Next oItem.Send

If Err = 0 Then 'Then use the Send action in the Tools menu 'to send the item from the Outbox Set octl = oApp.ActiveExplorer.CommandBars.FindControl(ID:=5488) octl.Execute End If

Set oApp = Nothing Set oCtl = Nothing Set oPop = Nothing Set oCB = Nothing Set oNS = Nothing Set oItem = Nothing End Sub

'-------------------------------------------------------------------------------------

Sub CopyToMRU() Dim objOL As Outlook.Application Dim objExpl As Outlook.Explorer Dim objSel As Outlook.Selection Dim colCB As Office.CommandBars Dim objCBB As Object Dim objItem As Object Dim objCopy As Object Set objOL = Application ' CreateObject("Outlook.Application") Set objExpl = objOL.ActiveExplorer Set objSel = objExpl.Selection Select Case objSel.Count Case 0 ' nothing selected; do nothing Case Is <= 10 For Each objItem In objSel Set objCopy = objItem.Copy objCopy.Save Next Set colCB = objExpl.CommandBars Set objCBB = colCB.FindControl(, 2778) If Not objCBB Is Nothing Then objCBB.Execute End If Case Is > 10 ' too many items End Select Set objCopy = Nothing Set objItem = Nothing Set objCBB = Nothing Set colCB = Nothing Set objSel = Nothing Set objExpl = Nothing Set objOL = Nothing End Sub

'------------------------------------------------------------------------------------

Sub ShowURL(strURL As String) Dim objExpl As Outlook.Explorer Dim colCB As Office.CommandBars Dim objCBB As Office.CommandBarComboBox On Error Resume Next Set objExpl = Application.ActiveExplorer Set colCB = objExpl.CommandBars Set objCBB = colCB.FindControl(, 1740) If Not objCBB Is Nothing Then objCBB.Text = strURL objCBB.Execute End If Set objCBB = Nothing Set colCB = Nothing Set objExpl = Nothing End Sub

[此贴子已经被作者于2004-7-28 17:26:35编辑过]