📄 frmpuboaemail.frm
字号:
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.Form frmPubOAEMail
Caption = "626"
ClientHeight = 5490
ClientLeft = 60
ClientTop = 345
ClientWidth = 8820
LinkTopic = "Form1"
ScaleHeight = 5490
ScaleWidth = 8820
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txtAccessory
Height = 285
Left = 1440
TabIndex = 7
Top = 2640
Width = 5505
End
Begin VB.TextBox txtKeyWord
Height = 285
Left = 1440
TabIndex = 6
Top = 2280
Width = 5505
End
Begin VB.TextBox txtTopic
Height = 285
Left = 1440
TabIndex = 5
Top = 1890
Width = 5505
End
Begin VB.TextBox txtCopyTo
Height = 315
Left = 1440
TabIndex = 4
Top = 1500
Width = 5505
End
Begin VB.TextBox txtAddressee
Height = 315
Left = 1440
TabIndex = 3
Top = 1110
Width = 5505
End
Begin VB.TextBox txtSendMen
Height = 315
Left = 1440
TabIndex = 2
Top = 720
Width = 5505
End
Begin VB.TextBox txtDraftID
Height = 270
Left = 6120
TabIndex = 1
Text = "000"
Top = 4500
Visible = 0 'False
Width = 855
End
Begin MSComctlLib.ImageList ImageList1
Left = 8040
Top = 540
_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 = "frmPubOAEMail.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmPubOAEMail.frx":0454
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmPubOAEMail.frx":08A8
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 555
Left = 0
TabIndex = 0
Top = 0
Width = 8820
_ExtentX = 15558
_ExtentY = 979
ButtonWidth = 661
ButtonHeight = 926
AllowCustomize = 0 'False
Wrappable = 0 'False
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 3
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "-"
Style = 3
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "143"
Key = "tbNew"
ImageIndex = 3
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "618"
Key = "tbSave"
ImageIndex = 1
EndProperty
EndProperty
BorderStyle = 1
End
Begin RichTextLib.RichTextBox RTxtSummary
Height = 1335
Left = 360
TabIndex = 8
Top = 3060
Width = 6615
_ExtentX = 11668
_ExtentY = 2355
_Version = 393217
TextRTF = $"frmPubOAEMail.frx":0BC4
End
Begin VB.Label lblSummary
Caption = "625"
Height = 195
Left = 360
TabIndex = 14
Top = 2670
Width = 1005
End
Begin VB.Label lblKeyWord
Caption = "624"
Height = 195
Left = 360
TabIndex = 13
Top = 2310
Width = 1005
End
Begin VB.Label lblTopic
Caption = "623"
Height = 195
Left = 360
TabIndex = 12
Top = 1920
Width = 1005
End
Begin VB.Label lblCopyto
Caption = "622"
Height = 195
Left = 360
TabIndex = 11
Top = 1560
Width = 1005
End
Begin VB.Label lblAddressee
Caption = "621"
Height = 195
Left = 360
TabIndex = 10
Top = 1200
Width = 1005
End
Begin VB.Label lblSendMen
Caption = "620"
Height = 195
Left = 360
TabIndex = 9
Top = 780
Width = 1005
End
End
Attribute VB_Name = "frmPubOAEMail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
'MsgBox EmailStyle
If EmailStyle = 2 Then
GetLocalEmail PubOAMain.TDBGrid1.Columns(6).Value
Else
If EmailStyle = 1 Then
If IsNull(PubOAMain.TDBGrid1.Columns(6).Value) Then Exit Sub
GetServerEmail PubOAMain.TDBGrid1.Columns(6).Value
Else
GetServerEmail NewID
End If
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.Caption = LoadResString(Val(Me.Caption & GLanguageID))
GGetRes GLanguageID, Me
Me.txtAddressee.Width = Me.Width - Me.txtAddressee.Left - 400
Me.txtCopyTo.Width = Me.Width - Me.txtCopyTo.Left - 400
Me.txtKeyWord.Width = Me.Width - Me.txtKeyWord.Left - 400
Me.txtSendMen.Width = Me.Width - Me.txtSendMen.Left - 400
Me.txtAccessory.Width = Me.Width - Me.txtAccessory.Left - 400
Me.txtTopic.Width = Me.Width - Me.txtTopic.Left - 400
Me.RTxtSummary.Width = Me.Width - Me.RTxtSummary.Left - 400
Me.RTxtSummary.Height = Me.Height - Me.RTxtSummary.Top - 700
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo Err_ButtonClick
Select Case Button.Key
Case "tbNew"
GetLocalEmail NewID
Case "tbSave"
SaveLocalEmail Me.txtDraftID.Text '保存在本地
'Case "tbSend"
' UpdateLocalEMail Me.txtDraftID.Text
' SaveServerEmail Me.txtDraftID.Text
'Case "tbRead"
' SaveLocalEmail Me.txtDraftID.Text
' DelServerEMail Me.txtDraftID.Text
'Case "tbCopyto"
' Case "tbDel"
' DelLocalEMail Me.txtDraftID.Text
End Select
Exit Sub
Err_ButtonClick:
MisMsg "ButtonClick Error:" & Err.Description
Exit Sub
End Sub
Private Sub SaveLocalEmail(EMailID As String)
On Error GoTo err_SaveLocalEmail
Dim rstEmail As Recordset
Set rstEmail = New Recordset
rstEmail.Open " Select * From PubOAData Where DraftID=" & EMailID & " and SendMen='" & LoginName & "' and Type=0 ", GetCNLocal, adOpenStatic, adLockOptimistic
With rstEmail
If .EOF Then
.AddNew
![DraftID] = EMailID
![SendDate] = Date
![SendMen] = Me.txtSendMen.Text & ""
![Addressee] = Me.txtAddressee.Text & ""
![CopyTo] = Me.txtCopyTo.Text & ""
![Topic] = Me.txtTopic.Text & ""
![KeyWord] = Me.txtKeyWord.Text & ""
![Summary] = Me.RTxtSummary.Text & ""
![Accessory] = Me.txtAccessory.Text & ""
![Type] = 0
.Update
Else
![DraftID] = EMailID
![SendDate] = Date
![SendMen] = Me.txtSendMen.Text & ""
![Addressee] = Me.txtAddressee.Text & ""
![CopyTo] = Me.txtCopyTo.Text & ""
![Topic] = Me.txtTopic.Text & ""
![KeyWord] = Me.txtKeyWord.Text & ""
![Summary] = Me.RTxtSummary.Text & ""
![Accessory] = Me.txtAccessory.Text & ""
![Type] = 0
.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] = Date
![SendMen] = Me.txtSendMen.Text & ""
![Addressee] = Me.txtAddressee.Text & ""
![CopyTo] = Me.txtCopyTo.Text & ""
![Topic] = Me.txtTopic.Text & ""
![KeyWord] = Me.txtKeyWord.Text & ""
![Summary] = Me.RTxtSummary.Text & ""
![Accessory] = Me.txtAccessory.Text & ""
.Update
Else
![DraftID] = EMailID
![SendDate] = Date
![SendMen] = Me.txtSendMen.Text & ""
![Addressee] = Me.txtAddressee.Text & ""
![CopyTo] = Me.txtCopyTo.Text & ""
![Topic] = Me.txtTopic.Text & ""
![KeyWord] = Me.txtKeyWord.Text & ""
![Summary] = Me.RTxtSummary.Text & ""
![Accessory] = Me.txtAccessory.Text & ""
.Update
End If
End With
Exit Sub
Err_SaveServerEmail:
MisMsg "SaveServerEmail Error: " & Err.Description
Exit Sub
End Sub
Private Sub GetLocalEmail(EMailID As String)
On Error GoTo Err_GetLocalEmail
Dim rstEmail As Recordset
Set rstEmail = New Recordset
rstEmail.Open "Select * From PubOAData Where DraftID=" & EMailID & " and SendMen='" & LoginName & "' ", GetCNLocal, adOpenForwardOnly
With rstEmail
If Not .EOF Then
Me.txtDraftID.Text = ![DraftID] & ""
Me.txtSendMen.Text = ![SendMen] & ""
Me.txtAddressee.Text = ![Addressee] & ""
Me.txtCopyTo.Text = ![CopyTo] & ""
Me.txtTopic.Text = ![Topic] & ""
Me.txtKeyWord.Text = ![KeyWord] & ""
Me.RTxtSummary.Text = ![Summary] & ""
Me.txtAccessory.Text = ![Accessory] & ""
Else
Me.txtDraftID.Text = EMailID
Me.txtSendMen.Text = LoginName
Me.txtAddressee.Text = ""
Me.txtCopyTo.Text = ""
Me.txtTopic.Text = ""
Me.txtKeyWord.Text = ""
Me.RTxtSummary.Text = ""
Me.txtAccessory.Text = ""
End If
End With
Exit Sub
Err_GetLocalEmail:
MisMsg "GetLocalEmail Error: " & Err.Description
Exit Sub
End Sub
Private Sub GetServerEmail(EMailID As String)
On Error GoTo Err_GetServerEmail
Dim rstEmail As Recordset
Set rstEmail = New Recordset
rstEmail.Open "Select * From PubOAData Where DraftID=" & EMailID & " and SendMen='" & LoginName & "'", GetCNClient, adOpenForwardOnly
With rstEmail
If Not .EOF Then
Me.txtDraftID.Text = ![DraftID] & ""
Me.txtSendMen.Text = ![SendMen] & ""
Me.txtAddressee.Text = ![Addressee] & ""
Me.txtCopyTo.Text = ![CopyTo] & ""
Me.txtTopic.Text = ![Topic] & ""
Me.txtKeyWord.Text = ![KeyWord] & ""
Me.RTxtSummary.Text = ![Summary] & ""
Me.txtAccessory.Text = ![Accessory] & ""
Else
Me.txtDraftID.Text = EMailID
Me.txtSendMen.Text = LoginName
Me.txtAddressee.Text = ""
Me.txtCopyTo.Text = ""
Me.txtTopic.Text = ""
Me.txtKeyWord.Text = ""
Me.RTxtSummary.Text = ""
Me.txtAccessory.Text = ""
End If
End With
Exit Sub
Err_GetServerEmail:
MisMsg "GetServerEmail 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 & "'"
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 SendMen='" & LoginName & "'"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -