SAM | |
Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules. |
You can call a contact from within Outlook. There's a checkbox in the dialer dialog; if it is checked, a journal entry will be created as soon as the call begins. If you want to record every call in the journal, you wish the box would be checked by default. That saves one mouse click, and you never would forget to check it. This sample demonstrates how to achieve that.
Add two new modules to your VBA project via Insert/Module, and press F4 to be able to name the modules. Call the first one 'modJournal', the other one 'modTimer'. Then add a class module, and call it 'OfficeButton'.
The sample has been tested with Outlook 2003 and works until Outlook 2010.
First copy the following code to the ThisOutlookSession module:
Private WithEvents m_Inspectors As Outlook.Inspectors Private Sub Application_Startup() Set m_Inspectors = Application.Inspectors End Sub Private Sub m_Inspectors_NewInspector(ByVal Inspector As Inspector) If TypeOf Inspector.CurrentItem Is Outlook.ContactItem Then modJournal.Initialize Inspector End If End Sub
Get here the code for the timer and copy it to modTimer: API-Timers. And copy the following lines to the OfficeButton class modul:
Public WithEvents Button As Office.CommandBarButton Private Sub Button_Click(ByVal Ctrl As Office.CommandBarButton, _ CancelDefault As Boolean _ ) EnableTimer 100, Nothing End Sub
Reporter | |
VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month. |
Here comes the code for the modJournal modul. See the comment at the top before the Sub Initialize(), if you're not running an English version of Outlook, you need to adjust both variables:
Private Declare Function GetDesktopWindowA Lib "user32" _ Alias "GetDesktopWindow" () As Long Private Declare Function GetWindow Lib "user32" _ (ByVal hWnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetWindowRectA Lib "user32" _ Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function GetWindowTextA Lib "user32" _ (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetClientRect Lib "user32" _ (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function GetCursorPos Lib "user32" _ (lpPoint As POINTAPI) As Long Private Declare Sub MouseEvent Lib "user32" Alias "mouse_event" _ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _ ByVal cButtons As Long, ByVal dwExtraInfo As Long) Private Const GW_CHILD = 5 Private Const GW_HWNDNEXT = 2 Private Const MOUSEEVENTF_LEFTDOWN = &H2 Private Const MOUSEEVENTF_LEFTUP = &H4 Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 Private Const MOUSEEVENTF_MIDDLEUP = &H40 Private Const MOUSEEVENTF_MOVE = &H1 Private Const MOUSEEVENTF_ABSOLUTE = &H8000 Private Const MOUSEEVENTF_RIGHTDOWN = &H8 Private Const MOUSEEVENTF_RIGHTUP = &H10 Private Type RECT left As Long top As Long right As Long bottom As Long End Type Private Type POINTAPI x As Long y As Long End Type Private m_OfficeButtons As VBA.Collection 'English names. Adjust for other languages if necessary Private Const m_DialogCaption As String = "New Call" Private Const m_CheckboxCaption As String = "Create new &Journal Entry when starting new call" Public Sub Initialize(Inspector As Outlook.Inspector) Set m_OfficeButtons = New VBA.Collection GetCommandbarButtons Inspector.CommandBars End Sub Private Sub GetCommandbarButtons(Bars As Office.CommandBars) Dim Bar As Office.CommandBar Dim Popup As Office.CommandBarPopup Dim Controls As Office.CommandBarControls Dim Ctrl As Office.CommandBarControl Dim Btn As OfficeButton Dim i&, y& Set Bar = Bars("Standard") Set Popup = Bar.FindControl(, 568) If Not Popup Is Nothing Then Set Controls = Popup.Controls For i = 1 To Controls.Count Set Ctrl = Controls(i) If TypeOf Ctrl Is Office.CommandBarButton Then Set Btn = New OfficeButton Set Btn.Button = Ctrl m_OfficeButtons.Add Btn ElseIf TypeOf Ctrl Is Office.CommandBarPopup Then Set Popup = Ctrl For y = 1 To Popup.Controls.Count Set Ctrl = Popup.Controls(y) If TypeOf Ctrl Is Office.CommandBarButton Then Set Btn = New OfficeButton Set Btn.Button = Ctrl m_OfficeButtons.Add Btn End If Next End If Next End If End Sub Public Sub TimerEvent() DisableTimer PushButton_CreateJournalEntryForNewCall End Sub Public Sub PushButton_CreateJournalEntryForNewCall() Dim lHnd As Long lHnd = GetHandle_CmdCreateJournalEntry If lHnd Then SendMouseClick lHnd, 1 End If End Sub Private Function GetHandle_CmdCreateJournalEntry() As Long Dim lHndDesktop As Long Dim lHndDlg As Long Dim lHndCmd As Long Dim DialogCaption As String Dim CheckboxCaption As String DialogCaption = m_DialogCaption CheckboxCaption = m_CheckboxCaption lHndDesktop = GetDesktopWindowA If lHndDesktop Then lHndDlg = FindChildWindowText(lHndDesktop, DialogCaption) If lHndDlg Then lHndCmd = FindChildWindowText(lHndDlg, CheckboxCaption) GetHandle_CmdCreateJournalEntry = lHndCmd End If End If End Function Private Function FindChildWindowText(ByVal lHwnd As Long, _ sFind As String _ ) As Long Dim lRes As Long Dim sFindLC As String lRes = GetWindow(lHwnd, GW_CHILD) If lRes Then sFindLC = LCase$(sFind) Select Case InStr(sFindLC, "*") Case Is > 0 Do If LCase$(GetWindowText(lRes)) Like sFindLC Then FindChildWindowText = lRes Exit Function End If lRes = GetWindow(lRes, GW_HWNDNEXT) Loop While lRes <> 0 Case Else Do If LCase$(GetWindowText(lRes)) = sFindLC Then FindChildWindowText = lRes Exit Function End If lRes = GetWindow(lRes, GW_HWNDNEXT) Loop While lRes <> 0 End Select End If End Function Private Function GetWindowText(ByVal lHwnd As Long) As String Const STR_SIZE As Long = 256 Dim sBuffer As String * STR_SIZE Dim lSize As Long sBuffer = String$(STR_SIZE, vbNullChar) lSize = GetWindowTextA(lHwnd, sBuffer, STR_SIZE) If lSize > 0 Then GetWindowText = left$(sBuffer, lSize) End If End Function Private Sub SendMouseClick(ByVal hWnd As Long, _ eButton As Long _ ) On Error Resume Next Dim tpRect As RECT Dim tpCursor As POINTAPI Dim x As Single Dim y As Single Dim dwFlag As Long Dim dx As Long Dim dy As Long ' current cursor position GetCursorPos tpCursor If GetWindowRectA(hWnd, tpRect) Then With tpRect x = .left + ((.right - .left) / 2) y = .top + ((.bottom - .top) / 2) End With If GetClientRect(GetDesktopWindowA, tpRect) Then ' Move cursor to the control dwFlag = MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE dx = x * (65535 / (tpRect.right)) dy = y * (65535 / (tpRect.bottom)) MouseEvent dwFlag, dx, dy, 0, 0 ' Click the control Select Case eButton Case 1 'vbLeftButton MouseEvent MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 MouseEvent MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 Case 4 'vbMiddleButton MouseEvent MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0 MouseEvent MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0 Case 2 'vbRightButton MouseEvent MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0 MouseEvent MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0 End Select ' Move cursor back dx = tpCursor.x * (65535 / (tpRect.right)) dy = tpCursor.y * (65535 / (tpRect.bottom)) MouseEvent dwFlag, dx, dy, 0, 0 End If End If End Sub
Category-Manager | |
With Category-Manager you can group your Outlook categories, share them with other users, filter a folder by category, automatically categorize new emails, and more. You can use the Addin even for IMAP. |