|
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编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2004-7-28 17:19