modfenfamail.bas

智能邮件管理信息系统

Attribute VB_Name = "ModFenFaMail"
Option Explicit





'自动分发所有邮件
Public Sub AutoFenFa(blnShowMsg As Boolean)
    
    Dim strsql As String
    Dim LngEmployeeID As Long
    Dim strEmployeeID As String
    Dim strCustomerID As String
    Dim LngCustomerID As Long
    Dim lngOkCount As Long
    Dim m_MailTypes As MailDll.Mails
    Dim mCustomers As PCustomer.Customers
    Dim mEmployees As PEmployee.Employees
    Dim mclsEmployee As New PEmployee.clsEmployee
    mclsEmployee.Init gdbCurrentDB
    
    Dim m_MailType As MailDll.MailType
    
    Dim lngMailCounter As Long
'    Dim lngEmployeeID As Long
    
    
    Dim mclsMailCreator1 As MailDll.Mail
    
    Set mclsMailCreator1 = GetMailCls
    
    Dim mclsCustomer As PCustomer.clsCustomer
    Set mclsCustomer = GetclsCustomer
    
    
    Dim recTmp As New ADODB.Recordset
    '只有收件箱才允许分发
    strsql = "select * from mail where lngEmployeeID=0 and LngOwnDefineTreeID=" & gLngOwnDefineTreeID 'strMailBoxTag='ReceptBox'"
    ModMailDll.GetMailsSimple strsql, m_MailTypes, mclsMailCreator1
    Dim lngMailCount As Long
    
    lngMailCount = m_MailTypes.Count
    
    For lngMailCounter = 0 To m_MailTypes.Count
        '"email地址匹配"规则：根据“发件人”email地址到联系人表中找到该信是哪个客户发来的，找到后，就把该客户对应的
        '职员的lngContactID存到mail表的lngContactID.这时该邮件就有了归属人?
        ' 还有考虑到一些特殊情况的分支处理，比如，找不到匹配的客户怎么办？ 有多个客户具有相同的email地址怎么办？
             
         '此处匹配邮件地址(客户中)
        If InStr(1, UCase(gdbCurrentDB.ConnectionString), UCase("Microsoft Access Driver")) > 0 Then
            strsql = "select * FROM Customer where ucase(strEmail)='" & UCase(Trim(m_MailTypes.Mail(lngMailCounter).StrReceiverString)) & "'"
        Else
            strsql = "select * FROM Customer where UPPER(strEmail)='" & UCase(Trim(m_MailTypes.Mail(lngMailCounter).StrReceiverString)) & "'"
        End If
    
         
         mclsCustomer.GetCustomers strsql, mCustomers
         strCustomerID = ""
         
         '判断客户的唯一性,多客户无法处理
         If mCustomers.Count = 1 Then
             '可能的客户ID列表
             LngCustomerID = mCustomers.Customer(0).LngCustomerID
             strCustomerID = LngCustomerID & ""
             
             
             '根据客户找到对应的职员列表ID
             strsql = "select lngEmployeeID from Customer where lngCustomerID =" & strCustomerID
             Dim i As Long
             mclsEmployee.GetEmployees strsql, mEmployees
             If mEmployees.Count > 0 Then
                LngEmployeeID = mEmployees.Employee(0).LngEmployeeID
                strEmployeeID = LngEmployeeID & ""
             Else
                GoTo ErrFenHandle
             End If
             
             
             
             '根据对应的可能的职员,加载菜单
             If Trim(strEmployeeID) <> "" Then
                 strsql = "select * FROM employee where lngEmployeeID=" & strEmployeeID
             End If
             mclsEmployee.GetEmployees strsql, mEmployees
             
             If mEmployees.Count = 1 Then
                LngEmployeeID = mEmployees.Employee(0).LngEmployeeID
                ModMailDll.GetMailSimple m_MailTypes.Mail(lngMailCounter).lngMailID, m_MailType, mclsMailCreator1
                m_MailType.LngEmployeeID = LngEmployeeID
                m_MailType.StrReadTag = MailDll.msReceiveNoRead
                m_MailType.BlnFenError = 0
                If m_MailType.lngMailID > 0 Then
                    If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
'                        frmmain.ctlMailList.RemoveRow False, False, lngMailCounter + 1
                        lngOkCount = lngOkCount + 1
                    Else
                        GoTo ErrFenHandle
                    End If
                End If
             Else
                GoTo ErrFenHandle
             End If
        Else
            GoTo ErrFenHandle
        End If
        GoTo BeginFenHandle
ErrFenHandle: '分发失败处理
           ModMailDll.GetMailSimple m_MailTypes.Mail(lngMailCounter).lngMailID, m_MailType, mclsMailCreator1
           m_MailType.BlnFenError = 1
           If m_MailType.lngMailID > 0 Then
                If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
                    If lngMailCounter + 1 <= frmMain.ctlMailList.Rows Then
                         frmMain.ctlMailList.MarkIconTag DataListGrid.Column_ErrFenTag, True, lngMailCounter + 1
                    End If
                End If
           End If
BeginFenHandle:
           
    Next lngMailCounter
    frmMain.RefreshMailList
    frmMain.RefreshTreeView
    
    If blnShowMsg Then
        ShowMessageBoxEx "待分发邮件数目:" & lngMailCount & "封.成功分发数目:" & lngOkCount & "封.无法分发数目:" & lngMailCount - lngOkCount & "封." & IIf(lngMailCounter - lngOkCount > 0, "客户email地址有重名，无法自动分发，请手工分发", "")
    Else
        Call frmMain.Status("待分发邮件数目:" & lngMailCount & "封.成功分发数目:" & lngOkCount & "封.无法分发数目:" & lngMailCount - lngOkCount & "封." & IIf(lngMailCounter - lngOkCount > 0, "客户email地址有重名，无法自动分发，请手工分发", ""))
    End If
    
    Set mclsMailCreator1 = Nothing
    Set mclsCustomer = Nothing
End Sub






'自动分发所有邮件
Private Sub AutoFenFaToMyself(blnShowMsg As Boolean)
    
    Dim strsql As String
    Dim LngEmployeeID As Long
    Dim strEmployeeID As String
    Dim strCustomerID As String
    Dim LngCustomerID As Long
    Dim mCustomers As PCustomer.Customers
    Dim mEmployees As PEmployee.Employees
    Dim mclsEmployee As New PEmployee.clsEmployee
    mclsEmployee.Init gdbCurrentDB
    Dim m_MailType As MailDll.MailType
    
    Dim m_MailTypes As MailDll.Mails
    
    Dim lngMailCounter As Long
    Dim mclsMailCreator1 As MailDll.Mail
    
    Set mclsMailCreator1 = GetMailCls
    
    Dim mclsCustomer As PCustomer.clsCustomer
    Set mclsCustomer = GetclsCustomer
    
    
    Dim recTmp As New ADODB.Recordset
    '只有收件箱才允许分发
    strsql = "select * from mail where lngEmployeeID=0 and LngOwnDefineTreeID=" & gLngOwnDefineTreeID 'strMailBoxTag='ReceptBox'"
    ModMailDll.GetMailsSimple strsql, m_MailTypes, mclsMailCreator1
    Dim lngMailCount As Long
    
    lngMailCount = m_MailTypes.Count
    
    For lngMailCounter = 0 To m_MailTypes.Count
        '"email地址匹配"规则：根据“发件人”email地址到联系人表中找到该信是哪个客户发来的，找到后，就把该客户对应的
        '职员的lngContactID存到mail表的lngContactID.这时该邮件就有了归属人?
        ' 还有考虑到一些特殊情况的分支处理，比如，找不到匹配的客户怎么办？ 有多个客户具有相同的email地址怎么办？
             
         '此处匹配邮件地址(客户中)
        If InStr(1, UCase(gdbCurrentDB.ConnectionString), UCase("Microsoft Access Driver")) > 0 Then
            strsql = "select * FROM Customer where ucase(strEmail)='" & UCase(Trim(m_MailTypes.Mail(lngMailCounter).StrReceiverString)) & "'"
        Else
            strsql = "select * FROM Customer where UPPER(strEmail)='" & UCase(Trim(m_MailTypes.Mail(lngMailCounter).StrReceiverString)) & "'"
        End If
         
         
         mclsCustomer.GetCustomers strsql, mCustomers
         strCustomerID = ""
         
         '判断客户的唯一性,多客户无法处理
         If mCustomers.Count = 1 Then
             '可能的客户ID列表
             LngCustomerID = mCustomers.Customer(0).LngCustomerID
             strCustomerID = LngCustomerID & ""
             
             
             '根据客户找到对应的职员列表ID
             strsql = "select lngEmployeeID from Customer where lngCustomerID =" & strCustomerID
             Dim i As Long
             mclsEmployee.GetEmployees strsql, mEmployees
             If mEmployees.Count > 0 Then
                LngEmployeeID = mEmployees.Employee(0).LngEmployeeID
                strEmployeeID = LngEmployeeID & ""
             Else
                
             End If
             
             
             
             '根据对应的可能的职员,加载菜单
             If Trim(strEmployeeID) <> "" Then
                 strsql = "select * FROM employee where lngEmployeeID=" & strEmployeeID
             End If
             mclsEmployee.GetEmployees strsql, mEmployees
             
             If mEmployees.Count = 1 Then
                LngEmployeeID = mEmployees.Employee(0).LngEmployeeID
                '如果需要分发的职员是当前职员，则分发给自己
                If LngEmployeeID = gLngEmployeeID1 Then
                    ModMailDll.GetMailSimple m_MailTypes.Mail(lngMailCounter).lngMailID, m_MailType, mclsMailCreator1
                    m_MailType.LngEmployeeID = LngEmployeeID
                    m_MailType.StrReadTag = MailDll.msReceiveNoRead
                    m_MailType.BlnFenError = 0
                    If m_MailType.lngMailID > 0 Then
                        If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
                        Else
                            Debug.Assert False
                        End If
                    End If
                End If
             Else
                
             End If
        Else
            
        End If
        GoTo BeginFenHandle
BeginFenHandle:
           
    Next lngMailCounter
    
    
    Set mclsMailCreator1 = Nothing
    Set mclsCustomer = Nothing
End Sub