modmailattach.bas

智能邮件管理信息系统

Attribute VB_Name = "ModMailAttachMenu"
Option Explicit

Public Sub pCreateMailAttachMenu(lnghwndOwner As Long, x As Long, y As Long)
    
    Dim strsql As String
    Dim strsql1 As String
    Dim LngEmployeeID As Long
    Dim strEmployeeID As String
    Dim strCustomerID As String
    Dim LngCustomerID As Long
    Dim lngCustomerCounter As Long
    Dim m_MailType As MailDll.MailType
    Dim mCustomer As PCustomer.Customer
    Dim mCustomers As PCustomer.Customers
    Dim mSystemMenus As PSystemMenu.SystemMenus
    Dim mSystemMenu As PSystemMenu.SystemMenu
    Dim m_MailTemplate As PMailTemplate.MailTemplate
    
    Dim mclsMailCreator1 As MailDll.Mail
    Set mclsMailCreator1 = GetMailCls
    GetMailSimple frmMain.ctlMailList.mlngCurrentSelectID, m_MailType, mclsMailCreator1
    
    Dim mZhuanFaEmployees As PEmployee.Employees
    
    Dim mclsCustomer1 As PCustomer.clsCustomer
    Set mclsCustomer1 = GetclsCustomer
    Dim mclsEmployee As New PEmployee.clsEmployee
    mclsEmployee.Init gdbCurrentDB
    Dim mEmployees As PEmployee.Employees
    
    


    '********************************************************************************
    '邮件分发处理
   '"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_MailType.StrReceiverString)) & "'"
    Else
        strsql = "select * FROM Customer where UPPER(strEmail)='" & UCase(Trim(m_MailType.StrReceiverString)) & "'"
    End If
    
    mclsCustomer1.GetCustomers strsql, mCustomers
    
        
    '转发给职员的列表
    strsql1 = "select * from Employee"
    mclsEmployee.GetEmployees strsql1, mZhuanFaEmployees
    strCustomerID = ""
    
    '可能的客户ID列表
    If mCustomers.Count > 0 Then
        For lngCustomerCounter = 0 To mCustomers.Count - 1
            LngCustomerID = mCustomers.Customer(lngCustomerCounter).LngCustomerID
            strCustomerID = strCustomerID & LngCustomerID & ","
        Next lngCustomerCounter

        If Trim(strCustomerID) <> "" Then
            If Right(strCustomerID, 1) = "," Then
                strCustomerID = left(strCustomerID, Len(strCustomerID) - 1)
                strCustomerID = "(" & strCustomerID & ")"
            Else
                strCustomerID = "(" & strCustomerID & ")"
            End If
        End If

        '根据客户找到对应的职员列表ID
        If Trim(strCustomerID) <> "" Then
            strsql = "select * from Customer where lngCustomerID in " & strCustomerID
        Else
            strsql = "select * from Customer "
        End If
        
        Dim i As Long
        mclsCustomer1.GetCustomers strsql, mCustomers
        If mCustomers.Count > 0 Then
            For i = 0 To mCustomers.Count
                LSet mCustomer = mCustomers.Customer(i)
                If mCustomer.LngEmployeeID > 0 Then
                    LngEmployeeID = mCustomer.LngEmployeeID
                    strEmployeeID = strEmployeeID & LngEmployeeID & ","
                End If
            Next i
        End If
        
        If Trim(strEmployeeID) <> "" Then
            If Right(strEmployeeID, 1) = "," Then
                strEmployeeID = left(strEmployeeID, Len(strEmployeeID) - 1)
                strEmployeeID = "(" & strEmployeeID & ")"
            Else
                strEmployeeID = "(" & strEmployeeID & ")"
            End If
        End If

        '根据对应的可能的职员,加载菜单
        If Trim(strEmployeeID) <> "" Then
            strsql = "select * FROM Employee where lngEmployeeID in " & strEmployeeID
        Else
            strsql = "select * FROM Employee "
        End If
    End If
    mclsEmployee.GetEmployees strsql, mEmployees
    '********************************************************************************


    '********************************************************************************
    '邮件归并

    '********************************************************************************
    
    Dim lngMenuCounter As Long
    Dim STRSQ As String
    
    Dim mclsSystemMenu As New clsSystemMenu
    mclsSystemMenu.Init gdbCurrentDB
    Dim mEmployee As PEmployee.Employee


    Set frmMain.mnuMailAttachMenu = New XpPopMenu.cPopupMenu

    With frmMain.mnuMailAttachMenu
        '在什么组件上显示出来(以那个组件为弹出坐标参照）
'        .ImageList = imgNormal
        .OfficeXpStyle = True
        .MenuBackgroundColor = -1
        .InActiveMenuForeColor = -1
        .ActiveMenuForeColor = -1
        .ActiveMenuBackgroundColor = -1
        .Font = Nothing
        .BackgroundPicture = Nothing
        .HeaderStyle = XpPopMenu.ecnmHeaderSeparator

        .HideInfrequentlyUsed = True
        .OfficeXpStyle = False
        Dim blnSelectMail As Boolean
        blnSelectMail = (frmMain.ctlMailList.mlngCurrentSelectID > 0)


        .ClearMenuItems
        .hwndOwner = lnghwndOwner
        .ImageList = frmMain.m_CImageListHot.hIml
'
'
        #If ChengRen = 1 Then
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenuChengRenSever' order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenuChengRen' order by intorder"
            End If
        #ElseIf V98989 = 1 Then
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenu98989Sever' order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenu98989' order by intorder"
            End If
        #ElseIf OneUser = 1 Then
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuOneUserPopMenuSever' order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuOneUserPopMenu' order by intorder"
            End If
        #Else
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenuSever' order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenu' order by intorder"
            End If
        #End If
         
        mclsSystemMenu.GetSystemMenus strsql, mSystemMenus
        If mSystemMenus.Count > 0 Then
            For lngMenuCounter = 0 To mSystemMenus.Count
                LSet mSystemMenu = mSystemMenus.SystemMenu(lngMenuCounter)
                If mSystemMenu.lngSystemMenuID > 0 Then
                    .AddMenuItem mSystemMenu.sKey, IIf(BlnEnglishVersion, mSystemMenu.sEnglishCaption, mSystemMenu.sCaption), mSystemMenu.strParenetKey, mSystemMenu.sHelptext, mSystemMenu.lItemData, mSystemMenu.iIconIndex, mSystemMenu.bChecked, blnSelectMail, mSystemMenu.bVisable
                End If
            Next lngMenuCounter
        End If
        
        
    
        If mEmployees.Count > 0 Then
            For i = 0 To mEmployees.Count - 1
                LSet mEmployee = mEmployees.Employee(i)
                .AddMenuItem "SendToOtherFen" & mEmployee.LngEmployeeID, mEmployee.strEmployeeName & "(" & mEmployee.strEmail & ")", "SendToOtherFen", , 10, , , blnSelectMail And (m_E_TreeViewType = m_OutlookTreeView)
            Next i
        End If

        
        '内部转发没有必要列出当前职员自己，而且当我转发给自己后，虽然看到有两封未读的邮件，但在左边的树形菜单中只显示了一封未读。重新登陆后，显示为两封。
        If mZhuanFaEmployees.Count > 0 Then
            For i = 0 To mZhuanFaEmployees.Count - 1
                LSet mEmployee = mZhuanFaEmployees.Employee(i)
'                If m_E_ViewMode = m_CliendMode Then '一般职员
                    If mEmployee.LngEmployeeID <> gLngEmployeeID1 Then
                        .AddMenuItem "SendToOtherZhuan" & mEmployee.LngEmployeeID, mEmployee.strEmployeeName & "(" & mEmployee.strEmail & ")", "SendToOtherZhuan", , 100, , , blnSelectMail
                    End If
'                End If
            Next i
        End If
            
            
        '如果是发件箱,修改打开邮件为 新增邮件
        If frmMain.ctlMailList.mlngViewID = 3 Then
            .MenuItemCaption("OpenMail") = "新建邮件"
            .MenuItemEnabled("OpenMail") = True
        End If
        
        
        
        '再次发送(&R)
        .MenuItemEnabled("ReSend") = (frmMain.ctlMailList.mlngViewID = 4)
        '回复
        .MenuItemEnabled("ReSender") = (blnSelectMail) And (frmMain.ctlMailList.mlngViewID = 2)
        '全部回复(&A)
        .MenuItemEnabled("ReAllMail") = (blnSelectMail) And (frmMain.ctlMailList.mlngViewID = 2)
        '转发(&F)
        .MenuItemEnabled("ResendMail") = (blnSelectMail)
        '作为附件转发(&W)
        .MenuItemEnabled("ResendAsFJ") = (blnSelectMail)
        
        .MenuItemEnabled("SendToOtherFenAll") = frmMain.ctlMailList.mlngViewID = 2
        .MenuItemEnabled("SendToOtherFen") = blnSelectMail And frmMain.ctlMailList.mlngViewID = 2
            
            
        
        '*归并的条件: 1.只有看过的邮件可以归并.
        '2.只有"收件箱"和"已发送邮件箱"中的邮件可以归并.
        '全部归并
        .MenuItemEnabled("SendToCustomerAll") = frmMain.ctlMailList.mlngViewID = 2 Or frmMain.ctlMailList.mlngViewID = 4
        '归并所选邮件
        .MenuItemEnabled("SendToCustomer") = blnSelectMail And (frmMain.ctlMailList.mlngViewID = 2 Or frmMain.ctlMailList.mlngViewID = 4)

        .MenuItemCaption("MailTrack") = IIf(BlnEnglishVersion, "MailTrack", IIf(m_MailType.btnTrack, "查看跟踪", "新建跟踪"))
        .MenuItemCaption("MailUNTrack") = IIf(BlnEnglishVersion, "UnMailTrack", "取消跟踪")
        .MenuItemEnabled("MailUNTrack") = blnSelectMail And (m_MailType.btnTrack <> 0)
        
        
                
        '设置权限中的可用只
        #If ChengRen = 1 Then
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenuChengRenSever' And bEnabled=0 order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenuChengRen' And bEnabled=0 order by intorder"
            End If
        #ElseIf V98989 = 1 Then
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenu98989Sever' And bEnabled=0 order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenu98989' And bEnabled=0 order by intorder"
            End If
        #ElseIf OneUser = 1 Then
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuOneUserPopMenuSever' And bEnabled=0 order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuOneUserPopMenu' And bEnabled=0 order by intorder"
            End If
        #Else
            If m_E_ViewMode = m_ServerMode Then
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenuSever' And bEnabled=0 order by intorder"
            Else
                strsql = "select * from SystemMenu Where strMenuName='mnuPopMenu' And bEnabled=0 order by intorder"
            End If
        #End If
        
        
        mclsSystemMenu.GetSystemMenus strsql, mSystemMenus
        If mSystemMenus.Count > 0 Then
            For lngMenuCounter = 0 To mSystemMenus.Count
                LSet mSystemMenu = mSystemMenus.SystemMenu(lngMenuCounter)
                If mSystemMenu.lngSystemMenuID > 0 Then
                    .MenuItemEnabled(mSystemMenu.sKey) = False
                End If
            Next lngMenuCounter
        End If

        .ShowPopupMenu x, y
    End With
    Set mclsSystemMenu = Nothing
    Set mclsCustomer1 = Nothing
    Set mclsMailCreator1 = Nothing

End Sub



Public Sub RaiseMailAttachMenu_Click(ItemNumber As Long)
    Dim mTemplngSelectionID() As Long
    Dim LngEmployeeID As Long
    Dim strKey As String
    Dim lngEmployeeIDArray() As Long
    Dim lngOkCount As Long
    Dim blnOk As Boolean
    Dim lngCurrentID As Long
    Dim m_MailType As MailDll.MailType
    Dim m_MailTemplate As PMailTemplate.MailTemplate
    
    Dim mclsMailTemplate1 As PMailTemplate.clsMailTemplate
    Set mclsMailTemplate1 = GetclsMailTemplate
    
    Dim m_AccountClass1 As Account.AccountClass
    Set m_AccountClass1 = GetAccountClass
    
    Dim strsql As String, strFilter As String
    Dim recTmp As New ADODB.Recordset
    
    If recTmp.State = adStateOpen Then recTmp.Close
    Dim mclsMailCreator1 As MailDll.Mail
    Set mclsMailCreator1 = GetMailCls
    Dim i As Long
    
    
    
    '内部分发(只有收件箱才允许)