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	joko	1.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