vb/MapiAccess/Actions.frm

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

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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26