udtpuboaemail.dob

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.UserDocument UdtPubOAEmail 
   ClientHeight    =   6165
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7530
   HScrollSmallChange=   225
   ScaleHeight     =   6165
   ScaleWidth      =   7530
   VScrollSmallChange=   225
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   1860
      Top             =   5700
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "UdtPubOAEmail.dox":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "UdtPubOAEmail.dox":0454
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "UdtPubOAEmail.dox":08A8
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.TextBox txtDraftID 
      Height          =   270
      Left            =   5640
      TabIndex        =   14
      Text            =   "000"
      Top             =   5040
      Width           =   855
   End
   Begin RichTextLib.RichTextBox RTxtAccessory 
      Height          =   1995
      Left            =   180
      TabIndex        =   13
      Top             =   3000
      Width           =   6615
      _ExtentX        =   11668
      _ExtentY        =   3519
      _Version        =   393217
      TextRTF         =   $"UdtPubOAEmail.dox":0BC4
   End
   Begin VB.TextBox txtSummary 
      Height          =   285
      Left            =   1260
      TabIndex        =   12
      Top             =   2580
      Width           =   5505
   End
   Begin VB.TextBox txtKeyWord 
      Height          =   285
      Left            =   1260
      TabIndex        =   10
      Top             =   2220
      Width           =   5505
   End
   Begin VB.TextBox txtTopic 
      Height          =   285
      Left            =   1260
      TabIndex        =   8
      Top             =   1830
      Width           =   5505
   End
   Begin VB.TextBox txtCopyTo 
      Height          =   315
      Left            =   1260
      TabIndex        =   6
      Top             =   1440
      Width           =   5505
   End
   Begin VB.TextBox txtAddressee 
      Height          =   315
      Left            =   1260
      TabIndex        =   4
      Top             =   1050
      Width           =   5505
   End
   Begin VB.TextBox txtSendMen 
      Height          =   315
      Left            =   1260
      TabIndex        =   2
      Top             =   660
      Width           =   5505
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7530
      _ExtentX        =   13282
      _ExtentY        =   979
      ButtonWidth     =   820
      ButtonHeight    =   926
      AllowCustomize  =   0   'False
      Wrappable       =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   7
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "-"
            Style           =   3
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "新增"
            Key             =   "tbNew"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存"
            Key             =   "tbSave"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "发送"
            Key             =   "tbSend"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "回复"
            Key             =   "tbReturn"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "转发"
            Key             =   "tbRelay"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "删除"
            Key             =   "tbDel"
            ImageIndex      =   1
         EndProperty
      EndProperty
   End
   Begin VB.Label lblSummary 
      Caption         =   "附  件"
      Height          =   195
      Left            =   180
      TabIndex        =   11
      Top             =   2610
      Width           =   1005
   End
   Begin VB.Label lblKeyWord 
      Caption         =   "关键字"
      Height          =   195
      Left            =   180
      TabIndex        =   9
      Top             =   2250
      Width           =   1005
   End
   Begin VB.Label lblTopic 
      Caption         =   "主  题"
      Height          =   195
      Left            =   180
      TabIndex        =   7
      Top             =   1860
      Width           =   1005
   End
   Begin VB.Label lblCopyto 
      Caption         =   "抄  送"
      Height          =   195
      Left            =   180
      TabIndex        =   5
      Top             =   1500
      Width           =   1005
   End
   Begin VB.Label lblAddressee 
      Caption         =   "接收人"
      Height          =   195
      Left            =   180
      TabIndex        =   3
      Top             =   1140
      Width           =   1005
   End
   Begin VB.Label lblSendMen 
      Caption         =   "发送人"
      Height          =   195
      Left            =   180
      TabIndex        =   1
      Top             =   720
      Width           =   1005
   End
End
Attribute VB_Name = "udtPubOAEmail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "tbNew"
            GetEmail NewID
        Case "tbSave"
        Case "tbSend"
        Case "tbReturn"
        Case "tbCopyto"
        Case "tbDel"
        
    End Select
End Sub

Private Sub UserDocument_Initialize()
    'GetEmail PubOAMain.Text1
'    If ReadcurrLogin("Value1") = "0" Then
'        GetEmail NewID
'    Else
'        'GetEmail ReadcurrLogin("Value1")
'
'    End If
End Sub


Private Function NewID() As String
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "Select top 1 DraftID From PubOAData  Order  By DraftID desc ", GetConnect, adOpenForwardOnly
    If rstEmail.EOF Then
        NewID = "1"
    Else
        NewID = Val(rstEmail![DraftID]) + 1
    End If

End Function
Private Sub SaveEmail(EmailID As String)
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "* From PubOAData Where DraftID='" & EmailID & "'", GetConnect, adOpenStatic, adLockOptimistic
    With rstEmail
        If .EOF Then
            .AddNew
            ![DraftID] = EmailID
            ![SendDate] = Date
            ![SendMen] = LoginName
            ![Addressee] = UserDocument.txtAddressee.Text
            ![CopyTo] = UserDocument.txtCopyTo.Text
            ![Topic] = UserDocument.txtTopic.Text
            ![KeyWord] = UserDocument.txtKeyWord.Text
            ![Summary] = UserDocument.txtSummary.Text
            ![Accessory] = UserDocument.RTxtAccessory.Text
            .Update
        Else
            ![DraftID] = EmailID
            ![SendDate] = Date
            ![SendMen] = LoginName
            ![Addressee] = UserDocument.txtAddressee.Text
            ![CopyTo] = UserDocument.txtCopyTo.Text
            ![Topic] = UserDocument.txtTopic.Text
            ![KeyWord] = UserDocument.txtKeyWord.Text
            ![Summary] = UserDocument.txtSummary.Text
            ![Accessory] = UserDocument.RTxtAccessory.Text
        
        End If
    End With
End Sub


Private Sub GetEmail(EmailID As String)
    
    Dim rstEmail As Recordset
    Set rstEmail = New Recordset
    rstEmail.Open "Select * From PubOAData Where DraftID=" & EmailID & " ", GetConnect, adOpenForwardOnly
    With rstEmail
        If Not .EOF Then
            UserDocument.txtDraftID.Text = ![DraftID] & ""
            UserDocument.txtSendMen.Text = ![SendMen] & ""
            UserDocument.txtAddressee.Text = ![Addressee] & ""
            UserDocument.txtCopyTo.Text = ![CopyTo] & ""
            UserDocument.txtTopic.Text = ![Topic] & ""
            UserDocument.txtKeyWord.Text = ![KeyWord] & ""
            UserDocument.txtSummary.Text = ![Summary] & ""
            UserDocument.RTxtAccessory.Text = ![Accessory] & ""
        Else
            UserDocument.txtDraftID.Text = EmailID
            UserDocument.txtSendMen.Text = ReadcurrLogin
            UserDocument.txtAddressee.Text = ""
            UserDocument.txtCopyTo.Text = ""
            UserDocument.txtTopic.Text = ""
            UserDocument.txtKeyWord.Text = ""
            UserDocument.txtSummary.Text = ""
            UserDocument.RTxtAccessory.Text = ""
        
        End If
    End With
End Sub

Private Sub UserDocument_Show()
    Dim strTemp As String
    strTemp = ReadcurrLogin("Value1")
    If strTemp = "0" Then
        GetEmail NewID
    Else
        GetEmail strTemp

    End If

End Sub