⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modguibingmail.bas

📁 智能邮件管理信息系统
💻 BAS
字号:
Attribute VB_Name = "ModGuiBingMail"
Option Explicit




'归并所有
'*归并的条件: 1.只有看过的邮件可以归并.
                '2.只有"收件箱"和"已发送邮件箱"中的邮件可以归并.
Public Sub GuiBingAll(blnShowMsg As Boolean)
    
    Dim strsql As String
    Dim strCustomerID As String
    Dim LngCustomerID As Long
    Dim lngOkCount As Long
    
    Dim lngMailCounter As Long
    Dim LngEmployeeID As Long
    Dim m_MailTypes As MailDll.Mails
    Dim mCustomers As PCustomer.Customers
    Dim m_MailType As MailDll.MailType
    
    Dim mclsCustomer1 As PCustomer.clsCustomer
    Set mclsCustomer1 = GetclsCustomer
    
    
    
    
    Dim recTmp As New ADODB.Recordset
    '2.只有"收件箱"和"已发送邮件箱"中的邮件可以归并.
    strsql = "select * from mail where  StrReadTag='Readed' and lngEmployeeID=" & gLngEmployeeID1 & " and  LngOwnDefineTreeID=" & gLngOwnDefineTreeID & " and lngCustomerID=0" '(strMailBoxTag='ReceptBox' or strMailBoxTag='SendedBox')
    
    Dim m_Contacts As PContact.Contacts
    Dim mclsMailCreator1 As MailDll.Mail
    
    Set mclsMailCreator1 = GetMailCls

    ModMailDll.GetMailsSimple strsql, m_MailTypes, mclsMailCreator1
    Dim lngMailCount As Long
    lngMailCount = m_MailTypes.Count
    
    
    For lngMailCounter = 0 To m_MailTypes.Count - 1
        LSet m_MailType = m_MailTypes.Mail(lngMailCounter)

        If m_MailType.StrReadTag = MailDll.msReceiveReaded And UCase(m_MailType.strMailBoxTag) = UCase("ReceptBox") Or UCase(m_MailType.strMailBoxTag) = UCase("SendedBox") Then
            '根据 发件人邮件地址,查询是哪个客户
            strsql = "select LngCustomerID from Customer" & IIf(m_E_ViewMode = m_ServerMode, " Where 3>2 ", " where LngEmployeeID =" & gLngEmployeeID1)
            
            If InStr(1, UCase(gdbCurrentDB.ConnectionString), UCase("Microsoft Access Driver")) > 0 Then
                strsql = strsql & " And Ucase(strEmail)='" & UCase(Trim(m_MailType.StrReceiverString)) & "'"
            Else
                strsql = strsql & " And UPPER(strEmail)='" & UCase(Trim(m_MailType.StrReceiverString)) & "'"
            End If
            '根据职员找到对应的客户列表ID
            mclsCustomer1.GetCustomers strsql, mCustomers
            If mCustomers.Count = 1 Then
               LngCustomerID = mCustomers.Customer(0).LngCustomerID
               m_MailType.LngCustomerID = LngCustomerID
               If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
                   frmMain.ctlMailList.RemoveRow False, True, 0
                   lngOkCount = lngOkCount + 1
               End If
            End If
        End If
    Next lngMailCounter
    
    
    frmMain.RefreshTreeView
    frmMain.RefreshMailList
    
    If blnShowMsg Then
        ShowMessageBoxEx "待归并邮件数目:" & lngMailCount & "封.成功归并发数目:" & lngOkCount & "封.无法归并数目:" & lngMailCounter - lngOkCount & "封."
    Else
        Call frmMain.Status("待归并邮件数目:" & lngMailCount & "封.成功归并数目:" & lngOkCount & "封.无法归并数目:" & lngMailCounter - lngOkCount & "封.")
    End If
    
    Set mclsMailCreator1 = Nothing
    Set mclsCustomer1 = Nothing
End Sub


'归并选择的邮件
'*归并的条件: 1.只有看过的邮件可以归并.
                '2.只有"收件箱"和"已发送邮件箱"中的邮件可以归并.
Public Sub GuiBingSelection(blnShowMsg As Boolean)

    Dim mCustomers As PCustomer.Customers
    Dim m_MailTypes As MailDll.Mails
    
    Dim strsql As String
    Dim strCustomerID As String
    Dim LngCustomerID As Long
    Dim lngOkCount As Long
    
    Dim lngMailCounter As Long
    Dim LngEmployeeID As Long
    Dim m_MailType As MailDll.MailType
    
    
    
    Dim mclsMailCreator1 As MailDll.Mail
    
    Set mclsMailCreator1 = GetMailCls
    
    Dim mclsCustomer1 As PCustomer.clsCustomer
    Set mclsCustomer1 = GetclsCustomer
    
    
    Dim recTmp As New ADODB.Recordset
    
    GetSelectionID m_lngSelectionID
    If UBound(m_lngSelectionID) > 0 Then
        For lngMailCounter = 0 To UBound(m_lngSelectionID)
            If m_lngSelectionID(lngMailCounter).lngSelectionID > 0 Then
                ModMailDll.GetMailSimple m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1
                If m_MailType.StrReadTag = MailDll.msReceiveReaded And UCase(m_MailType.strMailBoxTag) = UCase("ReceptBox") Or UCase(m_MailType.strMailBoxTag) = UCase("SendedBox") Then
                    '根据 发件人邮件地址,查询是哪个客户
                    strsql = "select LngCustomerID from Customer" & IIf(m_E_ViewMode = m_ServerMode, " Where 3>2 ", " where LngEmployeeID =" & gLngEmployeeID1)
                    
                    If InStr(1, UCase(gdbCurrentDB.ConnectionString), UCase("Microsoft Access Driver")) > 0 Then
                        strsql = strsql & " And Ucase(strEmail)='" & UCase(Trim(m_MailType.StrReceiverString)) & "'"
                    Else
                        strsql = strsql & " And UPPER(strEmail)='" & UCase(Trim(m_MailType.StrReceiverString)) & "'"
                    End If
                    '根据职员找到对应的客户列表ID
                    mclsCustomer1.GetCustomers strsql, mCustomers
                    If mCustomers.Count = 1 Then
                       LngCustomerID = mCustomers.Customer(0).LngCustomerID
                       m_MailType.LngCustomerID = LngCustomerID
                       If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
                           frmMain.ctlMailList.RemoveRow False, True, 0
                           lngOkCount = lngOkCount + 1
                       End If
                    End If
                End If
            End If
        Next lngMailCounter
    End If
    
    frmMain.RefreshTreeView
    frmMain.RefreshMailList
    
    If blnShowMsg Then
        ShowMessageBoxEx "待归并邮件数目:" & lngMailCounter - 1 & "封.成功归并发数目:" & lngOkCount & "封.无法归并数目:" & lngMailCounter - 1 - lngOkCount & "封."
    Else
        Call frmMain.Status("待归并邮件数目:" & lngMailCounter - 1 & "封.成功归并数目:" & lngOkCount & "封.无法归并数目:" & lngMailCounter - 1 - lngOkCount & "封.")
    End If
    Set mclsMailCreator1 = Nothing
    Set mclsCustomer1 = Nothing

End Sub



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -