/[cvs]/joko/ToolBox/Windows/HylaPrintMon_MapiContactsDumper/ModuleMain.bas
ViewVC logotype

Diff of /joko/ToolBox/Windows/HylaPrintMon_MapiContactsDumper/ModuleMain.bas

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

revision 1.3 by joko, Sat Sep 1 15:22:49 2007 UTC revision 1.4 by joko, Mon Sep 3 18:35:03 2007 UTC
# Line 5  Option Explicit Line 5  Option Explicit
5    
6  Public Sub Main()  Public Sub Main()
7            
8        ' testing
9        'MsgBox Get_User_Name()
10        
11      ' get port name from command line      ' get port name from command line
12      Dim hfax_port As String      Dim hfax_port As String
13      'hfax_port = "HFAX1:"      'hfax_port = "HFAX1:"
# Line 36  Public Sub Main() Line 39  Public Sub Main()
39            
40      ' open MAPI folder      ' open MAPI folder
41      mailerStart      mailerStart
42        
43        ' debugging
44        'MsgBox mailer.Session.CurrentUser()
45        
46      Dim contactsFolder As Outlook.MAPIFolder      Dim contactsFolder As Outlook.MAPIFolder
47            
48      If MapiFolderPath = "" Then      If MapiFolderPath = "" Then
# Line 45  Public Sub Main() Line 52  Public Sub Main()
52          Set contactsFolder = getFolderByPath(mailer.Session.Folders, MapiFolderPath, 0)          Set contactsFolder = getFolderByPath(mailer.Session.Folders, MapiFolderPath, 0)
53          If contactsFolder Is Nothing Then          If contactsFolder Is Nothing Then
54              MsgBox _              MsgBox _
55                  "Problem: Could not open MAPI folder '" & MapiFolderPath & "'." & vbCrLf & _                  "Problem while opening MAPI folder '" & MapiFolderPath & "'." & vbCrLf & _
56                  "Please configure properly in port settings dialog or registry:" & vbCrLf & vbCrLf & _                  "Maybe the server is not available?" & vbCrLf & vbCrLf & _
57                    "Otherwise please check in port settings dialog or registry:" & vbCrLf & _
58                  "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _                  "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _
59                  vbOKOnly, "ERROR"                  vbCritical + vbOKOnly, "Error"
60              End              End
61          End If          End If
62      End If      End If
# Line 67  Public Sub Main() Line 75  Public Sub Main()
75      If writeAddressbook(entries, AddressBookType, AddressBookPath, count) = True Then      If writeAddressbook(entries, AddressBookType, AddressBookPath, count) = True Then
76          MsgBox "Addressbook refreshed successfully (" & count & " entries).", vbInformation + vbOKOnly, "OK"          MsgBox "Addressbook refreshed successfully (" & count & " entries).", vbInformation + vbOKOnly, "OK"
77      Else      Else
78          MsgBox "Addressbook refresh failed.", vbExclamation + vbOKOnly, "ERROR"          MsgBox "Addressbook refresh failed.", vbExclamation + vbOKOnly, "Error"
79      End If      End If
80            
81  End Sub  End Sub
# Line 84  Private Function getFolderByPath(ByVal r Line 92  Private Function getFolderByPath(ByVal r
92      For Each part In parts      For Each part In parts
93          If part <> "" Then          If part <> "" Then
94              'MsgBox "part: " & part              'MsgBox "part: " & part
95                
96                ' get named folder
97              On Error Resume Next              On Error Resume Next
98              Set entry = rootFolders.Item(part)                  Set entry = rootFolders.Item(part)
99              If Err.Number <> 0 Then                  If Err.Number <> 0 Then
100                  MsgBox Err.Description & vbCrLf & vbCrLf & "Problem bei der Verwendung des Ordners '" & part & "', " & vbCrLf & "kompletter Pfad war '" & folderPath & "'.", vbOKOnly, "Error"                      MsgBox Err.Description & vbCrLf & vbCrLf & "Problem while using folder '" & part & "', " & vbCrLf & "complete path was '" & folderPath & "'.", vbExclamation + vbOKOnly, "Error"
101                  Exit Function                      Exit Function
102              End If                  End If
103              On Error GoTo 0              On Error GoTo 0
104                
105              'MsgBox "name: " & entry.Name              'MsgBox "name: " & entry.Name
106              Set rootFolders = entry.Folders              
107                ' get subfolders
108                On Error Resume Next
109                    Set rootFolders = entry.Folders
110                    If Err.Number <> 0 Then
111                        MsgBox Err.Description & vbCrLf & vbCrLf & "Problem while using subfolders of '" & part & "', " & vbCrLf & "complete path was '" & folderPath & "'.", vbExclamation + vbOKOnly, "Error"
112                        Exit Function
113                    End If
114                On Error GoTo 0
115                
116          End If          End If
117      Next      Next
118    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed