/[cvs]/joko/TestArea/vb/MapiAccess/Actions.frm
ViewVC logotype

Diff of /joko/TestArea/vb/MapiAccess/Actions.frm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by joko, Mon Jan 20 18:22:23 2003 UTC revision 1.2 by joko, Sat Sep 1 12:34:21 2007 UTC
# Line 1  Line 1 
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    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed