vb/MapiAccess/Actions.frm

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

1	VERSION 5.00
2	Begin VB.Form Actions
3	Caption = "Form1"
4	ClientHeight = 3825
5	ClientLeft = 60
6	ClientTop = 345
7	ClientWidth = 7065
8	LinkTopic = "Form1"
9	ScaleHeight = 3825
10	ScaleWidth = 7065
11	StartUpPosition = 1 'CenterOwner
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 Command1
21	Caption = "Command1"
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
101	' V2 - iterate all folders hierarchically (level 1 & 2)
102	' Dim myFolder As Outlook.MAPIFolder
103	' Dim mySubFolder As Outlook.MAPIFolder
104	' For Each myFolder In mailer.Session.Folders
105	' MsgBox "level1: " & myFolder.Name
106	' For Each mySubFolder In myFolder.Folders
107	' MsgBox "level2: " & mySubFolder.Name
108	' Next
109	' Next
110
111	' V3 - jump to the first "level 1" - folder and continue from there
112	Dim mainFolder As Outlook.MAPIFolder
113	Dim mySubFolder As Outlook.MAPIFolder
114	Set mainFolder = mailer.Session.Folders.GetFirst
115	For Each mySubFolder In mainFolder.Folders
116	'MsgBox "level2: " & mySubFolder.Name
117	If mySubFolder.Name = "test" Then Set getContactFolder = mySubFolder
118	Next
119
120	End Function
121
122	Private Function readMapiFolder(myFolder As Outlook.MAPIFolder)
123	Dim contactItem As Outlook.contactItem
124	Dim objAttribute As Variant
125	'myfolder.Items.Item(
126	Dim buffer As String
127	For Each contactItem In myFolder.Items
128	'MsgBox contactItem.NickName
129	'contactItem.us
130	'MsgBox contactItem.l
131	'Text1.Text = Text1.Text & contactItem.LastName & vbCrLf
132	buffer = buffer & "lastname: " & contactItem.LastName & vbCrLf
133	Next
134	readMapiFolder = buffer
135	End Function
136
137	Private Sub Command1_Click()
138
139	Dim dump As String
140	Dim cF As Outlook.MAPIFolder
141
142	Text1.Text = ""
143
144	mailerStart
145	Set cF = getContactFolder()
146	MsgBox cF.Name
147	dump = readMapiFolder(cF)
148	Text1.Text = Text1.Text & dump & vbCrLf
149	'mailerShutdown
150
151	End Sub
152
153	Private Sub slog(logString As String)
154	Text1.Text = Text1.Text & logString & vbCrLf
155	DoEvents
156	End Sub
157
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26