📄 modguibingmail.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 + -