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

📄 modmailattach.bas

📁 智能邮件管理信息系统
💻 BAS
📖 第 1 页 / 共 2 页
字号:
    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 + -