/[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.2 by joko, Sat Sep 1 15:18:39 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                  "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _                  "Otherwise please check in port settings dialog or registry:" & vbCrLf & _
58                  vbOKOnly, "ERROR"                  "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _
59                    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    
# Line 145  Private Function readMapiFolderToArray(m Line 165  Private Function readMapiFolderToArray(m
165  End Function  End Function
166    
167  Private Function getRegistrySetting(portName As String, subKey As String) As String  Private Function getRegistrySetting(portName As String, subKey As String) As String
168      getRegistrySetting = regQuery_A_Key(HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Control\Print\Monitors\Winprint Hylafax\Ports\" & portName, subKey)      getRegistrySetting = regQuery_A_Key(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Print\Monitors\Winprint Hylafax\Ports\" & portName, subKey)
169  End Function  End Function
170    
171  Private Function writeAddressbook(ByRef entries As Variant, abFormat As String, abPath As String, ByRef count As Integer) As Boolean  Private Function writeAddressbook(ByRef entries As Variant, abFormat As String, abPath As String, ByRef count As Integer) As Boolean
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed