OLKeeper | |
Der OLKeeper verhindert zuverlässig, dass Sie Microsoft Outlook unbeabsichtigt schlieÃen und so etwa wichtige Emails verpassen würden. |
Die Outlook Wählhilfe ermöglicht es, einen Kontakt anzurufen. Im sich dann öffnenden Dialog gibt es eine Checkbox; ist die markiert, wird bei Anrufbeginn automatisch ein neuer Journaleintrag erstellt. Wer alle Anrufe im Journal prokollieren möchte, wünscht sich, dass diese Checkbox standardmäÃig ausgewählt ist. Das spart einen Mausklick, und das Auswählen wird nicht mehr vergessen. Das folgende umfangreiche Beispiel demonstriert, wie Sie genau das erreichen.
Fügen Sie dem VBA-Projekt zwei neue Standardmodule über Einfügen/Modul hinzu. Drücken Sie dann f4, um die Module zu benennen. Das erste soll 'modJournal' und das zweite 'modTimer' heiÃen. Dann fügen Sie noch ein Klassenmodul hinzu und benennen es 'OfficeButton'.
Das Beispiel wurde mit Outlook 2003 getestet und funktioniert bis Outlook 2010. Seit Outlook 2013 werden die Office-Commandbars leider nicht mehr unterstützt.
Kopieren Sie zunächst folgenden Code ins Modul DieseOutlookSitzung:
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
Ins Modul modTimer kopieren Sie den Code des API-Timers. Und die folgenden Code-Zeilen kopieren Sie ins Klassenmodul OfficeButton:
Public WithEvents Button As Office.CommandBarButton Private Sub Button_Click(ByVal Ctrl As Office.CommandBarButton, _ CancelDefault As Boolean _ ) EnableTimer 100, Nothing End Sub
SAM | |
Legen Sie fest, mit welcher "Identität" Ihre Emails beim Empfänger erscheinen sollen. Mit SAM bestimmen Sie den Absender und Speicherort für Emails anhand von Regeln. |
Hier nun der Code fürs Modul modJournal. Beachten Sie den Kommentar oben vor Sub Initialize(), wenn Sie keine deutsche Outlookversion haben, müssen Sie die beiden Variablen anpassen:
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 'Deutsche Namen. Passen Sie das bei Bedarf für andere Sprachen an Private Const m_DialogCaption As String = "Neuer Telefonanruf" Private Const m_CheckboxCaption As String = "Bei Anrufbeginn neuen &Journaleintrag erstellen" 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
ReplyAll | |
Mit diesem Addin für Outlook erhalten Sie in verschiedenen Situationen eine Warnung, bevor Sie auf eine Email versehentlich allen anderen Empfängern antworten. |