frmoasellmain.frm

一个OA办公自动化管理系统

    
    Me.RTxtSummary.Text = Me.RTxtSummary.Text & strData & Chr(13) & Chr(10)

End Sub

Private Sub TDBGrid1_DblClick()
    If Me.TDBGrid1.Columns.Count > 2 Then
        frmPubOAEMail.Show 1
    Else
        If tcpClient.State = 0 Then tcpClient.Connect
    End If
End Sub
Private Sub FormatTDGrid()
    
    Me.TDBGrid1.MarqueeStyle = 4
    Me.TDBGrid1.Columns(0).Caption = "发件人"
    Me.TDBGrid1.Columns(1).Caption = "主题"
    Me.TDBGrid1.Columns(2).Caption = "发送日期"
    Me.TDBGrid1.Columns(0).Width = 2000
    Me.TDBGrid1.Columns(1).Width = 2000
    Me.TDBGrid1.Columns(2).Width = 2000
    Me.TDBGrid1.Columns(3).Visible = False
    Me.TDBGrid1.Columns(4).Visible = False
    Me.TDBGrid1.Columns(5).Visible = False
    Me.TDBGrid1.Columns(6).Visible = False

End Sub


Private Sub TDBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    If Me.TDBGrid1.Columns.Count > 2 Then Me.lblSend.Caption = "发件人：" & Me.TDBGrid1.Columns(0).Value & "    收件人：" & Me.TDBGrid1.Columns(3).Value
    If Me.TDBGrid1.Columns.Count > 2 Then Me.lblTopic.Caption = "主题：" & Me.TDBGrid1.Columns(1).Value
    If Me.TDBGrid1.Columns.Count > 2 Then Me.RTxtSummary.Text = Me.TDBGrid1.Columns(5).Value & ""

End Sub
Private Sub UnRead()
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "Select  SendMen, Topic, SendDate, Addressee, KeyWord, Summary, DraftID from PubOAData Where addressee='" & LoginName & "' ", GetCNClient, adOpenStatic, adLockReadOnly
    If rstEmail.RecordCount = 0 Then
        
        Warning "0"
'        Me.VtlMenu.MenuCur = 1
    Else
        Warning "1"
'        Me.VtlMenu.MenuCur = 3

    End If
    
    Set Me.TDBGrid1.DataSource = rstEmail
    FormatTDGrid
    LoadEmail
    
    Me.Toolbar1.Buttons(2).Enabled = True
    Me.Toolbar1.Buttons(3).Enabled = False
    Me.Toolbar1.Buttons(4).Enabled = True
    Me.Toolbar1.Buttons(5).Enabled = False

    Me.lblState.Caption = "     当前任务: 交流--未读信息"


End Sub
Private Sub Read()
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "Select  SendMen, Topic, SendDate, Addressee, KeyWord, Summary, DraftID from PubOAData Where addressee='" & LoginName & "' and Type=1 ", GetCNLocal, adOpenStatic, adLockReadOnly
    Set Me.TDBGrid1.DataSource = rstEmail
    FormatTDGrid
    LoadEmail
    Me.Toolbar1.Buttons(2).Enabled = True
    Me.Toolbar1.Buttons(3).Enabled = False
    Me.Toolbar1.Buttons(4).Enabled = False
    Me.Toolbar1.Buttons(5).Enabled = True

End Sub
Private Sub unSendBox()
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "Select  SendMen, Topic, SendDate, Addressee, KeyWord, Summary, DraftID from PubOAData Where SendMen='" & LoginName & "' and  type=0 and style=0", GetCNLocal, adOpenStatic, adLockReadOnly
    Set Me.TDBGrid1.DataSource = rstEmail
    FormatTDGrid
    LoadEmail
    Me.Toolbar1.Buttons(2).Enabled = True
    Me.Toolbar1.Buttons(3).Enabled = True
    Me.Toolbar1.Buttons(4).Enabled = False
    Me.Toolbar1.Buttons(5).Enabled = True

End Sub

Private Sub TBEnabled()
'    Me.Toolbar1.Buttons(2).Enabled = False
'    Me.Toolbar1.Buttons(3).Enabled = False
'    Me.Toolbar1.Buttons(4).Enabled = False
'    Me.Toolbar1.Buttons(5).Enabled = False

End Sub
Private Sub SendBox()
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "Select  SendMen, Topic, SendDate, Addressee, KeyWord, Summary, DraftID from PubOAData Where SendMen='" & LoginName & "'  and Type=0 and   Style=1", GetCNLocal, adOpenStatic, adLockReadOnly
    Set Me.TDBGrid1.DataSource = rstEmail
    FormatTDGrid
    LoadEmail
    Me.Toolbar1.Buttons(2).Enabled = True
    Me.Toolbar1.Buttons(3).Enabled = False
    Me.Toolbar1.Buttons(4).Enabled = False
    Me.Toolbar1.Buttons(5).Enabled = True

End Sub

Private Sub onLine()
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "SELECT LoginName, ComputerName FROM OAOnlineUser", GetCNClient, adOpenStatic, adLockReadOnly
    Set Me.TDBGrid1.DataSource = rstEmail
    Me.TDBGrid1.MarqueeStyle = 4
    Me.TDBGrid1.Columns(0).Caption = "在线用户"
    Me.TDBGrid1.Columns(1).Caption = "计算机名"
    Me.lblSend.Caption = "发送信息"
    Me.lblTopic.Caption = "收到信息"
    Me.Toolbar1.Buttons(2).Enabled = True
    Me.Toolbar1.Buttons(3).Enabled = False
    Me.Toolbar1.Buttons(4).Enabled = False
    Me.Toolbar1.Buttons(5).Enabled = False

End Sub

Private Sub Timer1_Timer()
    'MsgBox Format(Now - 1 / (24 * 12), "yyyy-mm-dd hh:mm:ss")
    GetCNClient.Execute "Delete from OAOnlineUser Where UpdateTime< '" & Format(Now - 1 / (24 * 12), "yyyy-mm-dd hh:mm:ss") & "'"
    GetCNClient.Execute "Update OAOnlineUser set UpdateTime='" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'      "
'    Dim rstEmail As Recordset
'    Set rstEmail = New Recordset
'    rstEmail.Open "SELECT LoginName, ComputerName FROM OAOnlineUser", GetCNClient, adOpenStatic, adLockReadOnly
'    Set Me.TDBGrid1.DataSource = rstEmail
    
    If Me.VtlMenu.MenuCur = 1 And Me.VtlMenu.MenuItemCur = 5 Then
        onLine
    End If
    TimeWarning
    
End Sub

Public Sub VtlMenu_MenuItemClick(MenuNumber As Long, MenuItem As Long)
    Dim i As Integer, rstEmail As Recordset
'    PubOAEmailID = "1"
'
'
'    Select Case MenuNumber
'
'        Case 1
'            Select Case MenuItem
'
'                Case 1
'                    EmailStyle = 1
'                    UnRead
'                Case 2
'                    EmailStyle = 2
'                    Read
'                Case 3
'                    EmailStyle = 2
'                    unSendBox
'                Case 4
'                    EmailStyle = 2
'                    SendBox
'
'                Case 5
'
'                    LoadTalk
'                    EmailStyle = 2
'                    onLine
'                Case Else
'                    Me.Picture1.Visible = False
'                    Me.Picture2.Visible = False
'            End Select
'
'        Case 2
'            Select Case MenuItem
'                Case 1
'
'                    WorkFlow
'                Case Else
                    
                    'TBEnabled
                    WorkFlow
                    Me.Picture1.Visible = False
                    Me.Picture2.Visible = True
                    
                    Dim f As Form
                    Dim s As New clsInput
                    Me.VtlMenu.MenuItemCur = MenuItem
                    If UCase(DLookUp("type", "PubOAPower", "FunctionID='" & Me.VtlMenu.MenuItemKey & "'")) = "FORM" Then
                        Set f = Forms.Add(Me.VtlMenu.MenuItemKey)
                        f.Show 1
                    Else
                        Set s = New clsInput
                        s.FormName = Me.VtlMenu.MenuItemKey
                        s.ShowForm
                        Set s = Nothing
                    End If
            
'            End Select

'        Case Is > 2
'            TBEnabled
'            WorkFlow
'            Me.Picture1.Visible = False
'            Me.Picture2.Visible = True
'
'            Dim f As Form
'            Dim s As New clsInput
'            Me.VtlMenu.MenuItemCur = MenuItem
'            If UCase(DLookUp("type", "PubOAPower", "FunctionID='" & Me.VtlMenu.MenuItemKey & "'")) = "FORM" Then
'                Set f = Forms.Add(Me.VtlMenu.MenuItemKey)
'                f.Show 1
'            Else
'                Set s = New clsInput
'                s.FormName = Me.VtlMenu.MenuItemKey
'                s.ShowForm
'                Set s = Nothing
'            End If

'        Case Else
'            Me.Picture1.Visible = False
'            Me.lblSend.Visible = False
'            Me.lblTopic.Visible = False
'            Me.RTxtSummary.Visible = False
'
'    End Select
    
    Me.VtlMenu.MenuCur = MenuNumber
    Me.VtlMenu.MenuItemCur = MenuItem
    Me.lblState.Caption = "     当前任务: " & Me.VtlMenu.MenuCaption & "--" & Me.VtlMenu.MenuItemCaption

End Sub



Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "tbNew"
            EmailStyle = 0
            frmPubOAEMail.Show 1
            UnRead
            'GetEmail NewID
        'Case "tbSave"
            'SaveEmail Me.txtDraftID.Text
        Case "tbSend"
            If IsNull(Me.TDBGrid1.Columns(6).Value) Then Exit Sub
            'MsgBox Me.TDBGrid1.Columns(3).Value
            If autoSend(Me.TDBGrid1.Columns(3).Value) = 1 Then
                SaveServerEmail Me.TDBGrid1.Columns(6).Value
                UpdateLocalEMail Me.TDBGrid1.Columns(6).Value
                
                MisMsg "发送成功！"
            Else
                MisMsg "发送失败！"
            
            End If
            unSendBox
'            SendBox
        Case "tbRead"
            If IsNull(Me.TDBGrid1.Columns(6).Value) Then Exit Sub
            
            SaveLocalEmail Me.TDBGrid1.Columns(6).Value, 1
            DelServerEMail Me.TDBGrid1.Columns(6).Value
            UnRead
            'Read
            'cmdLink_Click
        Case "tbCopyto"
        Case "tbDel"
            If IsNull(Me.TDBGrid1.Columns(6).Value) Then Exit Sub
            
            DelLocalEMail Me.TDBGrid1.Columns(6).Value
            SendBox
    End Select
End Sub

Private Sub SaveLocalEmail(EMailID As String, intType As Integer)
    On Error GoTo err_SaveLocalEmail
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open " Select *  From PubOAData Where DraftID=" & EMailID & " and addressee='" & LoginName & "' and Type=" & intType & " ", GetCNLocal, adOpenStatic, adLockOptimistic
    With rstEmail
        If .EOF Then
            .AddNew
            ![DraftID] = EMailID
            ![SendDate] = Me.TDBGrid1.Columns(2).Value
            ![SendMen] = Me.TDBGrid1.Columns(0).Value & ""
            ![Addressee] = Me.TDBGrid1.Columns(3).Value & ""
            '![CopyTo] = Me.TDBGrid1.Columns(0).Value & ""
            ![Topic] = Me.TDBGrid1.Columns(1).Value & ""
            ![KeyWord] = Me.TDBGrid1.Columns(4).Value & ""
            ![summary] = Me.TDBGrid1.Columns(5).Value & ""
            '![Accessory] = Me.TDBGrid1.Columns(0).Value & ""
            ![Type] = intType
            .Update
        Else
            ![DraftID] = EMailID
            ![SendDate] = Me.TDBGrid1.Columns(2).Value
            ![SendMen] = Me.TDBGrid1.Columns(0).Value & ""
            ![Addressee] = Me.TDBGrid1.Columns(3).Value & ""
            '![CopyTo] = Me.TDBGrid1.Columns(0).Value & ""
            ![Topic] = Me.TDBGrid1.Columns(1).Value & ""
            ![KeyWord] = Me.TDBGrid1.Columns(4).Value & ""
            ![summary] = Me.TDBGrid1.Columns(5).Value & ""
            ![Type] = intType
            .Update
        
        End If
    End With
    
    Exit Sub
err_SaveLocalEmail:
    MisMsg "SaveLocalEmail Error:" & Err.Description
    Exit Sub
End Sub

Private Sub SaveServerEmail(EMailID As String)
    On Error GoTo Err_SaveServerEmail
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open " Select *  From PubOAData Where DraftID=" & EMailID & " and SendMen='" & LoginName & "'", GetCNClient, adOpenStatic, adLockOptimistic
    With rstEmail
        If .EOF Then
            .AddNew
            ![DraftID] = EMailID
            ![SendDate] = Me.TDBGrid1.Columns(2).Value
            ![SendMen] = Me.TDBGrid1.Columns(0).Value & ""
            ![Addressee] = Me.TDBGrid1.Columns(3).Value & ""
            '![CopyTo] = Me.TDBGrid1.Columns(0).Value & ""
            ![Topic] = Me.TDBGrid1.Columns(1).Value & ""
            ![KeyWord] = Me.TDBGrid1.Columns(4).Value & ""
            ![summary] = Me.TDBGrid1.Columns(5).Value & ""
            ![style] = 0
            .Update
        Else
            ![DraftID] = EMailID
            ![SendDate] = Me.TDBGrid1.Columns(2).Value
            ![SendMen] = Me.TDBGrid1.Columns(0).Value & ""
            ![Addressee] = Me.TDBGrid1.Columns(3).Value & ""
            '![CopyTo] = Me.TDBGrid1.Columns(0).Value & ""
            ![Topic] = Me.TDBGrid1.Columns(1).Value & ""
            ![KeyWord] = Me.TDBGrid1.Columns(4).Value & ""
            ![summary] = Me.TDBGrid1.Columns(5).Value & ""
            ![style] = 0
            .Update
        
        End If
    End With
    Exit Sub
Err_SaveServerEmail:
    MisMsg "SaveServerEmail Error: " & Err.Description
    Exit Sub
End Sub

Private Sub UpdateLocalEMail(EMailID As String)
    GetCNLocal.Execute " update PubOAData set style='1' where DraftID=" & EMailID & " and SendMen='" & LoginName & "' and type=0  "
End Sub

Private Sub DelLocalEMail(EMailID As String)
    GetCNLocal.Execute " delete from PubOAData where DraftID=" & EMailID & " and SendMen='" & LoginName & "'"
End Sub


Private Sub DelServerEMail(EMailID As String)
    GetCNClient.Execute " delete from PubOAData where DraftID='" & EMailID & "'and addressee='" & LoginName & "'"
End Sub



Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
On Error GoTo Err_tcpClient_DataArrival
   Dim strData As String
   tcpClient.GetData strData
   Me.RTxtSummary.Text = strData
   If strData <> "" Then
     Beep
     Beep
   End If
   Exit Sub
Err_tcpClient_DataArrival:
   MisMsg "tcpClient_DataArrival Error : " & Err.Description
   Exit Sub
End Sub