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	joko	1.2	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