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