/[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.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                  "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _                  "Otherwise please check in port settings dialog or registry:" & vbCrLf & _
59                  vbOKOnly, "ERROR"                  "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Monitors\Winprint Hylafax\Ports\" & hfax_port & "\MapiFolderPath", _
60                    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    
# Line 145  Private Function readMapiFolderToArray(m Line 166  Private Function readMapiFolderToArray(m
166  End Function  End Function
167    
168  Private Function getRegistrySetting(portName As String, subKey As String) As String  Private Function getRegistrySetting(portName As String, subKey As String) As String
169      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)
170  End Function  End Function
171    
172  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.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed