| 1 |
VERSION 5.00 |
| 2 |
Begin VB.Form Actions |
| 3 |
Caption = "MapiContacts" |
| 4 |
ClientHeight = 3825 |
| 5 |
ClientLeft = 60 |
| 6 |
ClientTop = 345 |
| 7 |
ClientWidth = 7065 |
| 8 |
LinkTopic = "Form1" |
| 9 |
ScaleHeight = 3825 |
| 10 |
ScaleWidth = 7065 |
| 11 |
StartUpPosition = 1 'Fenstermitte |
| 12 |
Begin VB.TextBox Text1 |
| 13 |
Height = 2895 |
| 14 |
Left = 240 |
| 15 |
MultiLine = -1 'True |
| 16 |
TabIndex = 1 |
| 17 |
Top = 720 |
| 18 |
Width = 6615 |
| 19 |
End |
| 20 |
Begin VB.CommandButton CommandQueryContacts |
| 21 |
Caption = "&Query Contacts" |
| 22 |
Height = 375 |
| 23 |
Left = 240 |
| 24 |
TabIndex = 0 |
| 25 |
Top = 120 |
| 26 |
Width = 2415 |
| 27 |
End |
| 28 |
End |
| 29 |
Attribute VB_Name = "Actions" |
| 30 |
Attribute VB_GlobalNameSpace = False |
| 31 |
Attribute VB_Creatable = False |
| 32 |
Attribute VB_PredeclaredId = True |
| 33 |
Attribute VB_Exposed = False |
| 34 |
' 2002-07-27 |
| 35 |
|
| 36 |
Const bool_showProfileChooser As Boolean = True |
| 37 |
Const outlookProfileName As String = "x" |
| 38 |
Const outlookProfilePass As String = "" |
| 39 |
|
| 40 |
Dim mailer As Outlook.Application |
| 41 |
Dim bool_mailerAlreadyRunning As Boolean |
| 42 |
|
| 43 |
Private Function mailerCheckRunning() As Boolean |
| 44 |
Dim tmp As Variant |
| 45 |
On Error Resume Next |
| 46 |
tmp = mailer.ActiveExplorer.WindowState |
| 47 |
If Err.Number = 0 Then mailerCheckRunning = True |
| 48 |
On Error GoTo 0 |
| 49 |
End Function |
| 50 |
|
| 51 |
Private Function mailerStart() |
| 52 |
|
| 53 |
slog "creating mailer-object" |
| 54 |
Set mailer = New Outlook.Application |
| 55 |
DoEvents |
| 56 |
DoEvents |
| 57 |
|
| 58 |
bool_mailerAlreadyRunning = mailerCheckRunning |
| 59 |
|
| 60 |
If bool_mailerAlreadyRunning Then |
| 61 |
slog "*not* logging on, using running mailer" |
| 62 |
Else |
| 63 |
If bool_showProfileChooser Then |
| 64 |
slog "logging in (using Profile-Chooser), this may take some seconds!" |
| 65 |
mailer.Session.Logon , , 1 |
| 66 |
DoEvents |
| 67 |
DoEvents |
| 68 |
Else |
| 69 |
slog "logging in (auto-selecting profie " & outlookProfileName & "), this may take some seconds!" |
| 70 |
mailer.Session.Logon outlookProfileName, outlookProfilePass, 0 |
| 71 |
End If |
| 72 |
End If |
| 73 |
|
| 74 |
End Function |
| 75 |
|
| 76 |
Private Function mailerShutdown() |
| 77 |
|
| 78 |
slog "logging off" |
| 79 |
mailer.Session.Logoff |
| 80 |
|
| 81 |
If bool_mailerAlreadyRunning Then |
| 82 |
slog "*not* quitting running mailer!" |
| 83 |
Else |
| 84 |
slog "closing active mail-explorer" |
| 85 |
mailer.ActiveExplorer.Close |
| 86 |
slog "quitting mailer" |
| 87 |
mailer.Quit |
| 88 |
End If |
| 89 |
|
| 90 |
slog "destroying mailer-object" |
| 91 |
Set mailer = Nothing |
| 92 |
|
| 93 |
End Function |
| 94 |
|
| 95 |
Private Function getContactFolder() As Outlook.MAPIFolder |
| 96 |
slog "getting contacts" |
| 97 |
|
| 98 |
' ' V1 - get the default "Contacts"-folder |
| 99 |
' Set getContactFolder = mailer.Session.GetDefaultFolder(olFolderContacts) |
| 100 |
' Exit Function |
| 101 |
|
| 102 |
' ' V2 - iterate all folders hierarchically (level 1 & 2) |
| 103 |
' Dim myFolder As Outlook.MAPIFolder |
| 104 |
' Dim mySubFolder As Outlook.MAPIFolder |
| 105 |
' For Each myFolder In mailer.Session.Folders |
| 106 |
' MsgBox "level1: " & myFolder.Name |
| 107 |
' For Each mySubFolder In myFolder.Folders |
| 108 |
' MsgBox "level2: " & mySubFolder.Name |
| 109 |
' Next |
| 110 |
' Next |
| 111 |
|
| 112 |
' ' V3 - jump to the first "level 1" - folder and continue from there |
| 113 |
' Dim mainFolder As Outlook.MAPIFolder |
| 114 |
' Dim mySubFolder As Outlook.MAPIFolder |
| 115 |
' Set mainFolder = mailer.Session.Folders.GetFirst |
| 116 |
' For Each mySubFolder In mainFolder.Folders |
| 117 |
' 'MsgBox "level2: " & mySubFolder.Name |
| 118 |
' If mySubFolder.Name = "test" Then Set getContactFolder = mySubFolder |
| 119 |
' Next |
| 120 |
|
| 121 |
' V4 - navigate to specific (public) folder |
| 122 |
Dim rootFolder As Outlook.MAPIFolder, contactsFolder As Outlook.MAPIFolder |
| 123 |
'Dim contactsFolder As Outlook.AddressList |
| 124 |
'Dim entry |
| 125 |
Dim entry As Outlook.contactItem |
| 126 |
|
| 127 |
' "GetFirst()" may not always be reliable, see http://www.msexchangefaq.de/code/cdosample-pf.vbs.txt |
| 128 |
Set rootFolder = mailer.Session.Folders.GetFirst() |
| 129 |
'MsgBox rootFolder.AddressBookName |
| 130 |
Set contactsFolder = rootFolder.Folders("Alle Öffentlichen Ordner").Folders("EDV").Folders("plugin_test") |
| 131 |
' For Each entry In contactsFolder.Items |
| 132 |
' 'MsgBox "level2: " & mySubFolder.Name |
| 133 |
' 'If mySubFolder.Name = "test" Then Set getContactFolder = mySubFolder |
| 134 |
' slog entry.FirstName |
| 135 |
' Next |
| 136 |
'End |
| 137 |
|
| 138 |
Set getContactFolder = contactsFolder |
| 139 |
|
| 140 |
End Function |
| 141 |
|
| 142 |
Private Function readMapiFolder(myFolder As Outlook.MAPIFolder) |
| 143 |
Dim contactItem As Outlook.contactItem |
| 144 |
Dim objAttribute As Variant |
| 145 |
'myfolder.Items.Item( |
| 146 |
Dim buffer As String |
| 147 |
For Each contactItem In myFolder.Items |
| 148 |
'MsgBox contactItem.NickName |
| 149 |
'contactItem.us |
| 150 |
'MsgBox contactItem.l |
| 151 |
'Text1.Text = Text1.Text & contactItem.LastName & vbCrLf |
| 152 |
buffer = buffer & _ |
| 153 |
"firstname: " & contactItem.FirstName & vbCrLf & _ |
| 154 |
"lastname: " & contactItem.LastName & vbCrLf & _ |
| 155 |
"business fax: " & contactItem.BusinessFaxNumber & vbCrLf & _ |
| 156 |
"email: " & contactItem.Email1DisplayName & " <" & contactItem.Email1Address & ">" & vbCrLf |
| 157 |
Next |
| 158 |
readMapiFolder = buffer |
| 159 |
End Function |
| 160 |
|
| 161 |
Private Sub CommandQueryContacts_Click() |
| 162 |
|
| 163 |
Dim dump As String |
| 164 |
Dim cF As Outlook.MAPIFolder |
| 165 |
|
| 166 |
Text1.Text = "" |
| 167 |
|
| 168 |
mailerStart |
| 169 |
Set cF = getContactFolder() |
| 170 |
MsgBox "folder name: " & cF.Name |
| 171 |
dump = readMapiFolder(cF) |
| 172 |
|
| 173 |
' output contact to text box |
| 174 |
slog "-----------------------------------------------" |
| 175 |
slog dump |
| 176 |
|
| 177 |
'mailerShutdown |
| 178 |
|
| 179 |
End Sub |
| 180 |
|
| 181 |
Private Sub slog(logString As String) |
| 182 |
Text1.Text = Text1.Text & logString & vbCrLf |
| 183 |
DoEvents |
| 184 |
End Sub |
| 185 |
|
Parent Directory
| 
Revision Log
