--- joko/ToolBox/Windows/HylaPrintMon_MapiContactsDumper/ModuleMain.bas	2007/09/01 15:22:49	1.3
+++ joko/ToolBox/Windows/HylaPrintMon_MapiContactsDumper/ModuleMain.bas	2007/09/03 18:35:03	1.4
@@ -5,6 +5,9 @@
 
 Public Sub Main()
     
+    ' testing
+    'MsgBox Get_User_Name()
+    
     ' get port name from command line
     Dim hfax_port As String
     'hfax_port = "HFAX1:"
@@ -36,6 +39,10 @@
     
     ' open MAPI folder
     mailerStart
+    
+    ' debugging
+    'MsgBox mailer.Session.CurrentUser()
+    
     Dim contactsFolder As Outlook.MAPIFolder
     
     If MapiFolderPath = "" Then
@@ -45,10 +52,11 @@
         Set contactsFolder = getFolderByPath(mailer.Session.Folders, MapiFolderPath, 0)
         If contactsFolder Is Nothing Then
             MsgBox _
-                "Problem: Could not open MAPI folder '" & MapiFolderPath & "'." & vbCrLf & _
-                "Please configure properly in port settings dialog or registry:" & vbCrLf & vbCrLf & _
+                "Problem while opening MAPI folder '" & MapiFolderPath & "'." & vbCrLf & _
+                "Maybe the server is not available?" & vbCrLf & vbCrLf & _
+                "Otherwise please check in port settings dialog or registry:" & vbCrLf & _
                 "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _
-                vbOKOnly, "ERROR"
+                vbCritical + vbOKOnly, "Error"
             End
         End If
     End If
@@ -67,7 +75,7 @@
     If writeAddressbook(entries, AddressBookType, AddressBookPath, count) = True Then
         MsgBox "Addressbook refreshed successfully (" & count & " entries).", vbInformation + vbOKOnly, "OK"
     Else
-        MsgBox "Addressbook refresh failed.", vbExclamation + vbOKOnly, "ERROR"
+        MsgBox "Addressbook refresh failed.", vbExclamation + vbOKOnly, "Error"
     End If
     
 End Sub
@@ -84,15 +92,27 @@
     For Each part In parts
         If part <> "" Then
             'MsgBox "part: " & part
+            
+            ' get named folder
             On Error Resume Next
-            Set entry = rootFolders.Item(part)
-            If Err.Number <> 0 Then
-                MsgBox Err.Description & vbCrLf & vbCrLf & "Problem bei der Verwendung des Ordners '" & part & "', " & vbCrLf & "kompletter Pfad war '" & folderPath & "'.", vbOKOnly, "Error"
-                Exit Function
-            End If
+                Set entry = rootFolders.Item(part)
+                If Err.Number <> 0 Then
+                    MsgBox Err.Description & vbCrLf & vbCrLf & "Problem while using folder '" & part & "', " & vbCrLf & "complete path was '" & folderPath & "'.", vbExclamation + vbOKOnly, "Error"
+                    Exit Function
+                End If
             On Error GoTo 0
+            
             'MsgBox "name: " & entry.Name
-            Set rootFolders = entry.Folders
+            
+            ' get subfolders
+            On Error Resume Next
+                Set rootFolders = entry.Folders
+                If Err.Number <> 0 Then
+                    MsgBox Err.Description & vbCrLf & vbCrLf & "Problem while using subfolders of '" & part & "', " & vbCrLf & "complete path was '" & folderPath & "'.", vbExclamation + vbOKOnly, "Error"
+                    Exit Function
+                End If
+            On Error GoTo 0
+            
         End If
     Next