📄 modmailattach.bas
字号:
If frmMain.mnuMailAttachMenu.MenuItemData(ItemNumber) = 10 Then
strKey = frmMain.mnuMailAttachMenu.MenuItemKey(ItemNumber)
strKey = Replace(UCase(strKey), UCase("SendToOtherFen"), "")
LngEmployeeID = Val(strKey)
GetSelectionID m_lngSelectionID
If UBound(m_lngSelectionID) > 0 Then
For lngMailCounter = 0 To UBound(m_lngSelectionID)
If m_lngSelectionID(lngMailCounter).lngSelectionID > 0 Then
ModMailDll.GetMail m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1, True, True, True, True
'分发邮件的时候,修改邮件的操作员,客户ID
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, True, True, True, True) Then
' frmmain.ctlMailList.RemoveRow False, False, lngMailCounter + 1
Else
ModMailDll.GetMailSimple m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1
m_MailType.BlnFenError = 1
If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, True, True, True, True) Then
'frmMain.ctlMailList.MarkIconTag DataListGrid.Column_ErrFenTag, True, m_lngSelectionID(lngMailCounter).lngRow
End If
End If
End If
End If
Next
frmMain.RefreshMailList
frmMain.RefreshTreeView
End If
Exit Sub
ElseIf frmMain.mnuMailAttachMenu.MenuItemData(ItemNumber) = 100 Then '内部转发
strKey = frmMain.mnuMailAttachMenu.MenuItemKey(ItemNumber)
strKey = Replace(UCase(strKey), UCase("SendToOtherZhuan"), "")
LngEmployeeID = Val(strKey)
Set mclsMailCreator1 = GetMailCls
GetSelectionID m_lngSelectionID
If UBound(m_lngSelectionID) > 0 Then
For lngMailCounter = 0 To UBound(m_lngSelectionID)
If m_lngSelectionID(lngMailCounter).lngSelectionID > 0 Then
ModMailDll.GetMail m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1, True, True, True, True
'分发邮件的时候,修改邮件的操作员,客户ID
m_MailType.lngMailID = 0
For i = 0 To UBound(m_MailType.strMailAttach)
m_MailType.strMailAttach(i).lngMailAttachId = 0
Next i
For i = 0 To UBound(m_MailType.strMailImage)
m_MailType.strMailImage(i).lngMailImageID = 0
Next i
m_MailType.LngEmployeeID = LngEmployeeID
m_MailType.strMailBoxTag = "ReceptBox" 'shou件箱
m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.InMailBox
m_MailType.StrReadTag = MailDll.msReceiveNoRead
m_MailType.BlnFenError = 0
If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, True, True, True, True) Then
blnOk = True
Else
blnOk = False
End If
End If
If blnOk Then lngOkCount = lngOkCount + 1
Next
End If
ShowMessageBoxEx "待转发邮件:" & UBound(m_lngSelectionID) & "封,成功转发" & lngOkCount & "封!"
Exit Sub
'内部分发 所有
ElseIf UCase(frmMain.mnuMailAttachMenu.MenuItemKey(ItemNumber)) = UCase("SendToOtherFenAll") Then
AutoFenFa True
End If
Select Case UCase(frmMain.mnuMailAttachMenu.MenuItemKey(ItemNumber))
'*归并的条件: 1.只有看过的邮件可以归并.
'2.只有"收件箱"和"已发送邮件箱"中的邮件可以归并.
'全部归并
Case UCase("SendToCustomerAll")
ModGuiBingMail.GuiBingAll True
'归并所选邮件
Case UCase("SendToCustomer")
GuiBingSelection True
'选择多个联系人转发
Case UCase("SendToOtherSZhuan")
strsql = "select lngEmployeeID,strEmployeeName,strEmail from Employee"
If gLngEmployeeID1 > 0 Then
strsql = "select lngEmployeeID,strEmployeeName,strEmail from Employee Where LngEmployeeID<>" & gLngEmployeeID1
End If
FrmSelectMutiContact.ShowMe strsql, lngEmployeeIDArray
If FrmSelectMutiContact.e_Action = ok Then
Dim ii As Long
GetSelectionID m_lngSelectionID
If UBound(m_lngSelectionID) > 0 And UBound(lngEmployeeIDArray) > 0 Then
For lngMailCounter = 0 To UBound(m_lngSelectionID)
If m_lngSelectionID(lngMailCounter).lngSelectionID > 0 Then
Set mclsMailCreator1 = GetMailCls
ModMailDll.GetMail m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1, True, True, True, True
'转发邮件的时候,修改邮件的操作员
For ii = 0 To UBound(lngEmployeeIDArray)
If lngEmployeeIDArray(ii) > 0 Then
m_MailType.LngEmployeeID = lngEmployeeIDArray(ii)
m_MailType.lngMailID = 0
For i = 0 To UBound(m_MailType.strMailAttach)
m_MailType.strMailAttach(i).lngMailAttachId = 0
Next i
For i = 0 To UBound(m_MailType.strMailImage)
m_MailType.strMailImage(i).lngMailImageID = 0
Next i
m_MailType.strMailBoxTag = "ReceptBox" 'shou件箱
m_MailType.lngOwnDefineTreeID = MailDll.E_SystemMailBox.InMailBox
m_MailType.StrReadTag = MailDll.msReceiveNoRead
If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, True, True, True, True) Then
blnOk = True
Else
blnOk = False
End If
End If
Next ii
If blnOk Then lngOkCount = lngOkCount + 1
End If
Next
End If
ShowMessageBoxEx "待转发邮件:" & UBound(m_lngSelectionID) & "封,成功转发" & lngOkCount & "封!"
End If
Case UCase("OPENMAIL")
blnIsBusy = True
'如果是发件箱,修改打开邮件为 新增邮件
If frmMain.ctlMailList.mlngViewID = 3 Then
Dim mlngCurrentSelectID As Long
mclsMailTemplate1.GetMailTemplate 0, m_MailTemplate
blnIsBusy = True
#If SubClass = 1 Then
mlngCurrentSelectID = ModMailDll.AddMail(m_MailTemplate, m_E_ViewMode, IIf(m_E_ViewMode = m_ServerMode, 0, gLngEmployeeID1), gLngOwnDefineTreeID, mclsMailCreator1)
#End If
If mlngCurrentSelectID > 0 Then
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail mlngCurrentSelectID, True
End If
frmMain.RefreshMailList
frmMain.RefreshTreeView
End If
blnIsBusy = False
Else
Set mclsMailCreator1 = GetMailCls
ModMailDll.EditMail frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, mclsMailCreator1
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail frmMain.ctlMailList.mlngCurrentSelectID, True
End If
frmMain.RefreshMailList
frmMain.RefreshTreeView
End If
blnIsBusy = False
Case UCase("PRINTMAIL")
If frmMain.ctlMailList.mlngCurrentSelectID > 0 Then frmMain.ctlMailBrowser.PrintDoc
Case UCase("RESENDER") '回复发件人
blnIsBusy = True
Set mclsMailCreator1 = GetMailCls
lngCurrentID = ModMailDll.Writeback(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, mclsMailCreator1)
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail lngCurrentID, True
End If
frmMain.RefreshMailList
frmMain.RefreshTreeView
blnIsBusy = False
Case UCase("OwnDefine")
Dim p As New PView1.clsView1
p.Init gdbCurrentDB, frmMain.ctlMailList.mlngViewID
p.EditView1ShowDialog frmMain.ctlMailList.mlngViewID
Case UCase("REALLMAIL") '全部回复发件人
blnIsBusy = True
Set mclsMailCreator1 = GetMailCls
lngCurrentID = ModMailDll.WriteBackAll(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, mclsMailCreator1)
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail lngCurrentID, True
End If
frmMain.RefreshMailList
frmMain.RefreshTreeView
blnIsBusy = False
Case UCase("RESENDMAIL") '转发信件
blnIsBusy = True
Set mclsMailCreator1 = GetMailCls
lngCurrentID = ModMailDll.Transmit(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, mclsMailCreator1)
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail lngCurrentID, True
End If
frmMain.RefreshMailList
frmMain.RefreshTreeView
blnIsBusy = False
Case UCase("RESENDASFJ") '作为附件转发
blnIsBusy = True
Set mclsMailCreator1 = GetMailCls
lngCurrentID = ModMailDll.WriteAsAttach(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, mclsMailCreator1)
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail lngCurrentID, True
End If
blnIsBusy = False
frmMain.RefreshMailList
frmMain.RefreshTreeView
Case UCase("ReSend") '再次发送
Set mclsMailCreator1 = GetMailCls
lngCurrentID = ModMailDll.ReSend(frmMain.ctlMailList.mlngCurrentSelectID, gLngEmployeeID1, mclsMailCreator1)
If ModMailDll.BlnExcuteSendMail(mclsMailCreator1) Then
frmMain.m_CSmtpInterface.SendAMail lngCurrentID, True
End If
frmMain.RefreshMailList
frmMain.RefreshTreeView
Case UCase("MARKREADED") '标记为已读
GetSelectionID m_lngSelectionID
If UBound(m_lngSelectionID) > 0 Then
For lngMailCounter = 0 To UBound(m_lngSelectionID)
Set mclsMailCreator1 = GetMailCls
ModMailDll.GetMailSimple m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1
m_MailType.StrReadTag = MailDll.msReceiveReaded
If m_MailType.lngMailID > 0 Then
If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
'frmMain.ctlMailList.MarkIconTag DataListGrid.E_ColumnIconTag.Column_ReadTag, True, m_lngSelectionID(lngMailCounter).lngRow
frmMain.RefreshTreeView
End If
End If
Next
End If
Case UCase("MARKUNREAD") '标记为未读
Set mclsMailCreator1 = GetMailCls
GetSelectionID m_lngSelectionID
If UBound(m_lngSelectionID) > 0 Then
For lngMailCounter = 0 To UBound(m_lngSelectionID)
ModMailDll.GetMailSimple m_lngSelectionID(lngMailCounter).lngSelectionID, m_MailType, mclsMailCreator1
m_MailType.StrReadTag = MailDll.msReceiveNoRead
If m_MailType.lngMailID > 0 Then
If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
'frmMain.ctlMailList.MarkIconTag DataListGrid.E_ColumnIconTag.Column_ReadTag, False, m_lngSelectionID(lngMailCounter).lngRow
frmMain.RefreshTreeView
End If
End If
Next
End If
Case UCase("MOVETOFOLDER")
GetSelectionID2 mTemplngSelectionID
If UBound(mTemplngSelectionID) > 0 Then
If frmSelectFolder.ShowCard(mTemplngSelectionID, True) Then
frmMain.RefreshTreeView
End If
End If
Case UCase("COPYTOFOLDER")
GetSelectionID2 mTemplngSelectionID
If UBound(mTemplngSelectionID) > 0 Then
If frmSelectFolder.ShowCard(mTemplngSelectionID, False) Then
frmMain.RefreshTreeView
End If
End If
Case UCase("DELETEMAIL")
'删除当前选择的
frmMain.SendRecycle False
Case UCase("ADDSENDERTOACCOUNTS")
Case UCase("MailTrack") '新建/查看 邮件跟踪
Set mclsMailCreator1 = GetMailCls
If frmMain.ctlMailList.mlngCurrentSelectID > 0 Then
ModMailDll.GetMailSimple frmMain.ctlMailList.mlngCurrentSelectID, m_MailType, mclsMailCreator1
If ModMailDll.EditTrack(m_MailType, mclsMailCreator1) Then
'frmMain.ctlMailList.MarkIconTag DataListGrid.Column_TrackTag, True, frmMain.ctlMailList.SelectedRow
End If
End If
Case UCase("MailUNTrack") '取消邮件跟踪
Set mclsMailCreator1 = GetMailCls
ModMailDll.GetMailSimple frmMain.ctlMailList.mlngCurrentSelectID, m_MailType, mclsMailCreator1
If m_MailType.btnTrack <> 0 Then
m_MailType.btnTrack = 0
m_MailType.intTrackDays = 0
m_MailType.strTrackContent = ""
If ModMailDll.SaveMail(m_MailType, mclsMailCreator1, False, False, False, False) Then
'frmMain.ctlMailList.MarkIconTag DataListGrid.Column_TrackTag, False, frmMain.ctlMailList.SelectedRow
frmMain.RefreshMailList
End If
End If
End Select
Set mclsMailTemplate1 = Nothing
Set m_AccountClass1 = Nothing
Set mclsMailCreator1 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -