--- joko/TestArea/vb/MapiAccess/Actions.frm 2003/01/20 18:22:23 1.1 +++ joko/TestArea/vb/MapiAccess/Actions.frm 2007/09/01 12:34:21 1.2 @@ -1,157 +1,185 @@ -VERSION 5.00 -Begin VB.Form Actions - Caption = "Form1" - ClientHeight = 3825 - ClientLeft = 60 - ClientTop = 345 - ClientWidth = 7065 - LinkTopic = "Form1" - ScaleHeight = 3825 - ScaleWidth = 7065 - StartUpPosition = 1 'CenterOwner - Begin VB.TextBox Text1 - Height = 2895 - Left = 240 - MultiLine = -1 'True - TabIndex = 1 - Top = 720 - Width = 6615 - End - Begin VB.CommandButton Command1 - Caption = "Command1" - Height = 375 - Left = 240 - TabIndex = 0 - Top = 120 - Width = 2415 - End -End -Attribute VB_Name = "Actions" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False -' 2002-07-27 - -Const bool_showProfileChooser As Boolean = True -Const outlookProfileName As String = "x" -Const outlookProfilePass As String = "" - -Dim mailer As Outlook.Application -Dim bool_mailerAlreadyRunning As Boolean - -Private Function mailerCheckRunning() As Boolean - Dim tmp As Variant - On Error Resume Next - tmp = mailer.ActiveExplorer.WindowState - If Err.Number = 0 Then mailerCheckRunning = True - On Error GoTo 0 -End Function - -Private Function mailerStart() - - slog "creating mailer-object" - Set mailer = New Outlook.Application - DoEvents - DoEvents - - bool_mailerAlreadyRunning = mailerCheckRunning - - If bool_mailerAlreadyRunning Then - slog "*not* logging on, using running mailer" - Else - If bool_showProfileChooser Then - slog "logging in (using Profile-Chooser), this may take some seconds!" - mailer.Session.Logon , , 1 - DoEvents - DoEvents - Else - slog "logging in (auto-selecting profie " & outlookProfileName & "), this may take some seconds!" - mailer.Session.Logon outlookProfileName, outlookProfilePass, 0 - End If - End If - -End Function - -Private Function mailerShutdown() - - slog "logging off" - mailer.Session.Logoff - - If bool_mailerAlreadyRunning Then - slog "*not* quitting running mailer!" - Else - slog "closing active mail-explorer" - mailer.ActiveExplorer.Close - slog "quitting mailer" - mailer.Quit - End If - - slog "destroying mailer-object" - Set mailer = Nothing - -End Function - -Private Function getContactFolder() As Outlook.MAPIFolder - slog "getting contacts" - - ' V1 - get the default "Contacts"-folder - ' Set getContactFolder = mailer.Session.GetDefaultFolder(olFolderContacts) - - ' V2 - iterate all folders hierarchically (level 1 & 2) -' Dim myFolder As Outlook.MAPIFolder -' Dim mySubFolder As Outlook.MAPIFolder -' For Each myFolder In mailer.Session.Folders -' MsgBox "level1: " & myFolder.Name -' For Each mySubFolder In myFolder.Folders -' MsgBox "level2: " & mySubFolder.Name -' Next -' Next - - ' V3 - jump to the first "level 1" - folder and continue from there - Dim mainFolder As Outlook.MAPIFolder - Dim mySubFolder As Outlook.MAPIFolder - Set mainFolder = mailer.Session.Folders.GetFirst - For Each mySubFolder In mainFolder.Folders - 'MsgBox "level2: " & mySubFolder.Name - If mySubFolder.Name = "test" Then Set getContactFolder = mySubFolder - Next - -End Function - -Private Function readMapiFolder(myFolder As Outlook.MAPIFolder) - Dim contactItem As Outlook.contactItem - Dim objAttribute As Variant - 'myfolder.Items.Item( - Dim buffer As String - For Each contactItem In myFolder.Items - 'MsgBox contactItem.NickName - 'contactItem.us - 'MsgBox contactItem.l - 'Text1.Text = Text1.Text & contactItem.LastName & vbCrLf - buffer = buffer & "lastname: " & contactItem.LastName & vbCrLf - Next - readMapiFolder = buffer -End Function - -Private Sub Command1_Click() - - Dim dump As String - Dim cF As Outlook.MAPIFolder - - Text1.Text = "" - - mailerStart - Set cF = getContactFolder() - MsgBox cF.Name - dump = readMapiFolder(cF) - Text1.Text = Text1.Text & dump & vbCrLf - 'mailerShutdown - -End Sub - -Private Sub slog(logString As String) - Text1.Text = Text1.Text & logString & vbCrLf - DoEvents -End Sub - +VERSION 5.00 +Begin VB.Form Actions + Caption = "MapiContacts" + ClientHeight = 3825 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 7065 + LinkTopic = "Form1" + ScaleHeight = 3825 + ScaleWidth = 7065 + StartUpPosition = 1 'Fenstermitte + Begin VB.TextBox Text1 + Height = 2895 + Left = 240 + MultiLine = -1 'True + TabIndex = 1 + Top = 720 + Width = 6615 + End + Begin VB.CommandButton CommandQueryContacts + Caption = "&Query Contacts" + Height = 375 + Left = 240 + TabIndex = 0 + Top = 120 + Width = 2415 + End +End +Attribute VB_Name = "Actions" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +' 2002-07-27 + +Const bool_showProfileChooser As Boolean = True +Const outlookProfileName As String = "x" +Const outlookProfilePass As String = "" + +Dim mailer As Outlook.Application +Dim bool_mailerAlreadyRunning As Boolean + +Private Function mailerCheckRunning() As Boolean + Dim tmp As Variant + On Error Resume Next + tmp = mailer.ActiveExplorer.WindowState + If Err.Number = 0 Then mailerCheckRunning = True + On Error GoTo 0 +End Function + +Private Function mailerStart() + + slog "creating mailer-object" + Set mailer = New Outlook.Application + DoEvents + DoEvents + + bool_mailerAlreadyRunning = mailerCheckRunning + + If bool_mailerAlreadyRunning Then + slog "*not* logging on, using running mailer" + Else + If bool_showProfileChooser Then + slog "logging in (using Profile-Chooser), this may take some seconds!" + mailer.Session.Logon , , 1 + DoEvents + DoEvents + Else + slog "logging in (auto-selecting profie " & outlookProfileName & "), this may take some seconds!" + mailer.Session.Logon outlookProfileName, outlookProfilePass, 0 + End If + End If + +End Function + +Private Function mailerShutdown() + + slog "logging off" + mailer.Session.Logoff + + If bool_mailerAlreadyRunning Then + slog "*not* quitting running mailer!" + Else + slog "closing active mail-explorer" + mailer.ActiveExplorer.Close + slog "quitting mailer" + mailer.Quit + End If + + slog "destroying mailer-object" + Set mailer = Nothing + +End Function + +Private Function getContactFolder() As Outlook.MAPIFolder + slog "getting contacts" + +' ' V1 - get the default "Contacts"-folder +' Set getContactFolder = mailer.Session.GetDefaultFolder(olFolderContacts) +' Exit Function + +' ' V2 - iterate all folders hierarchically (level 1 & 2) +' Dim myFolder As Outlook.MAPIFolder +' Dim mySubFolder As Outlook.MAPIFolder +' For Each myFolder In mailer.Session.Folders +' MsgBox "level1: " & myFolder.Name +' For Each mySubFolder In myFolder.Folders +' MsgBox "level2: " & mySubFolder.Name +' Next +' Next + +' ' V3 - jump to the first "level 1" - folder and continue from there +' Dim mainFolder As Outlook.MAPIFolder +' Dim mySubFolder As Outlook.MAPIFolder +' Set mainFolder = mailer.Session.Folders.GetFirst +' For Each mySubFolder In mainFolder.Folders +' 'MsgBox "level2: " & mySubFolder.Name +' If mySubFolder.Name = "test" Then Set getContactFolder = mySubFolder +' Next + + ' V4 - navigate to specific (public) folder + Dim rootFolder As Outlook.MAPIFolder, contactsFolder As Outlook.MAPIFolder + 'Dim contactsFolder As Outlook.AddressList + 'Dim entry + Dim entry As Outlook.contactItem + + ' "GetFirst()" may not always be reliable, see http://www.msexchangefaq.de/code/cdosample-pf.vbs.txt + Set rootFolder = mailer.Session.Folders.GetFirst() + 'MsgBox rootFolder.AddressBookName + Set contactsFolder = rootFolder.Folders("Alle Öffentlichen Ordner").Folders("EDV").Folders("plugin_test") +' For Each entry In contactsFolder.Items +' 'MsgBox "level2: " & mySubFolder.Name +' 'If mySubFolder.Name = "test" Then Set getContactFolder = mySubFolder +' slog entry.FirstName +' Next + 'End + + Set getContactFolder = contactsFolder + +End Function + +Private Function readMapiFolder(myFolder As Outlook.MAPIFolder) + Dim contactItem As Outlook.contactItem + Dim objAttribute As Variant + 'myfolder.Items.Item( + Dim buffer As String + For Each contactItem In myFolder.Items + 'MsgBox contactItem.NickName + 'contactItem.us + 'MsgBox contactItem.l + 'Text1.Text = Text1.Text & contactItem.LastName & vbCrLf + buffer = buffer & _ + "firstname: " & contactItem.FirstName & vbCrLf & _ + "lastname: " & contactItem.LastName & vbCrLf & _ + "business fax: " & contactItem.BusinessFaxNumber & vbCrLf & _ + "email: " & contactItem.Email1DisplayName & " <" & contactItem.Email1Address & ">" & vbCrLf + Next + readMapiFolder = buffer +End Function + +Private Sub CommandQueryContacts_Click() + + Dim dump As String + Dim cF As Outlook.MAPIFolder + + Text1.Text = "" + + mailerStart + Set cF = getContactFolder() + MsgBox "folder name: " & cF.Name + dump = readMapiFolder(cF) + + ' output contact to text box + slog "-----------------------------------------------" + slog dump + + 'mailerShutdown + +End Sub + +Private Sub slog(logString As String) + Text1.Text = Text1.Text & logString & vbCrLf + DoEvents +End Sub +