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