frmmaildone.frm
来自「一套鞋厂的销售管理系统」· FRM 代码 · 共 1,106 行 · 第 1/4 页
FRM
1,106 行
ColumnWidth = 1214.929
EndProperty
EndProperty
End
Begin VB.ListBox MailAttList
Height = 1035
Left = 5160
TabIndex = 10
Top = 3240
Width = 2775
End
Begin RichTextLib.RichTextBox MailRead
Height = 2655
Left = 5160
TabIndex = 9
Top = 480
Width = 2775
_ExtentX = 4895
_ExtentY = 4683
_Version = 393217
Enabled = -1 'True
TextRTF = $"frmMailDone.frx":0000
End
Begin VB.PictureBox PicSend
Height = 3855
Left = 240
ScaleHeight = 3795
ScaleWidth = 4635
TabIndex = 5
Top = 480
Visible = 0 'False
Width = 4695
Begin VB.CommandButton MailSend
Caption = "邮件发送"
Height = 615
Left = 2400
TabIndex = 8
Top = 3120
Width = 1455
End
Begin VB.CommandButton MailSendDone
Caption = "邮件生成"
Height = 615
Left = 480
TabIndex = 7
Top = 3120
Width = 1455
End
Begin VSFlex6Ctl.vsFlexGrid vsSend
Height = 3015
Left = 0
TabIndex = 6
Top = 0
Width = 4695
_cx = 1187929
_cy = 1184966
_ConvInfo = -1
Appearance = 0
BorderStyle = 1
Enabled = -1 'True
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MousePointer = 0
BackColor = -2147483643
ForeColor = -2147483640
BackColorFixed = -2147483633
ForeColorFixed = -2147483630
BackColorSel = -2147483635
ForeColorSel = -2147483634
BackColorBkg = -2147483636
BackColorAlternate= -2147483643
GridColor = -2147483633
GridColorFixed = -2147483632
TreeColor = -2147483632
FloodColor = 192
SheetBorder = -2147483642
FocusRect = 1
HighLight = 1
AllowSelection = -1 'True
AllowBigSelection= -1 'True
AllowUserResizing= 1
SelectionMode = 0
GridLines = 1
GridLinesFixed = 2
GridLineWidth = 1
Rows = 50
Cols = 10
FixedRows = 1
FixedCols = 1
RowHeightMin = 0
RowHeightMax = 0
ColWidthMin = 0
ColWidthMax = 0
ExtendLastCol = 0 'False
FormatString = ""
ScrollTrack = 0 'False
ScrollBars = 3
ScrollTips = 0 'False
MergeCells = 0
MergeCompare = 0
AutoResize = -1 'True
AutoSizeMode = 0
AutoSearch = 0
MultiTotals = -1 'True
SubtotalPosition= 1
OutlineBar = 0
OutlineCol = 0
Ellipsis = 0
ExplorerBar = 0
PicturesOver = 0 'False
FillStyle = 0
RightToLeft = 0 'False
PictureType = 0
TabBehavior = 0
OwnerDraw = 0
Editable = 0 'False
ShowComboButton = -1 'True
WordWrap = 0 'False
TextStyle = 0
TextStyleFixed = 0
OleDragMode = 0
OleDropMode = 0
DataMode = 0
VirtualData = 0 'False
DataMember = ""
End
End
Begin MSComctlLib.TabStrip TabMail
Height = 4335
Left = 120
TabIndex = 0
Top = 120
Width = 4935
_ExtentX = 8705
_ExtentY = 7646
_Version = 393216
BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628}
NumTabs = 2
BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "邮件接收"
Key = "MailRecive"
ImageVarType = 2
EndProperty
BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628}
Caption = "邮件发送"
Key = "MailSend"
ImageVarType = 2
EndProperty
EndProperty
End
Begin MSMAPI.MAPISession MailSession
Left = 0
Top = 360
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DownloadMail = 0 'False
LogonUI = 0 'False
NewSession = 0 'False
End
Begin MSMAPI.MAPIMessages MailMessage
Left = 0
Top = 1440
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AddressEditFieldCount= 1
AddressModifiable= 0 'False
AddressResolveUI= 0 'False
FetchSorted = 0 'False
FetchUnreadOnly = 0 'False
End
End
Attribute VB_Name = "frmMailDone"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
On Error Resume Next
Dim i As Long, j As Long, XX As New FileSystemObject, s As String, Z As Long
Dim cn1 As New ADODB.Connection, Rst1 As New ADODB.Recordset, rst2 As New ADODB.Recordset, rst3 As New ADODB.Recordset
Dim RZrst As New ADODB.Recordset, RZSubrst As New ADODB.Recordset
Me.MousePointer = 11
For i = 1 To Me.MailMessage.MsgCount
Me.MailMessage.MsgIndex = i - 1
For j = 1 To Me.MailMessage.AttachmentCount
Me.MailMessage.AttachmentIndex = j - 1
s = ""
For Z = 1 To Len(Me.MailMessage.AttachmentName)
If Mid(Me.MailMessage.AttachmentName, Z, 1) = "\" Then
s = ""
Else
s = s & Mid(Me.MailMessage.AttachmentName, Z, 1)
End If
Next
If Right(s, 4) = ".mdb" And Len(s) = 12 And Mid(s, 7, 1) = "办" Then
rstclose RZrst
RZrst.Open "select * from E_Mail_Recive where packagename like '" & Left(s, Len(s) - 4) & "%' order by packagename", GetConnect, adOpenStatic, adLockOptimistic
If RZrst.RecordCount = 0 Then
XX.CopyFile Me.MailMessage.AttachmentPathName, "D:\X\" & s
RZrst.AddNew
RZrst![recivedate] = Me.MailMessage.MsgDateReceived
RZrst![packagename] = s
RZrst![runflag] = False
RZrst.Update
Else
RZrst.MoveLast
If s > RZrst![packagename] Then
XX.CopyFile Me.MailMessage.AttachmentPathName, "D:\X\" & s
RZrst.AddNew
RZrst![recivedate] = Me.MailMessage.MsgDateReceived
RZrst![packagename] = s
RZrst![runflag] = False
RZrst.Update
End If
End If
RZrst.Close
End If
Next
Next
Me.MousePointer = 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
Dim i As Long, j As Long, XX As New FileSystemObject, s As String, Z As Long, ss As String
Dim cn1 As New ADODB.Connection, Rst1 As New ADODB.Recordset, rst2 As New ADODB.Recordset, rst3 As New ADODB.Recordset
Dim RZrst As New ADODB.Recordset, RZSubrst As New ADODB.Recordset
Dim dbfcn As New ADODB.Connection
Me.MousePointer = 11
'取消处理
Set Rst1 = New Recordset
Rst1.Open "select max(e_mail_recive_bill.htmlname) as htmlname,left(e_mail_recive_bill.htmlname,15) as selladresscode from e_mail_recive_bill where runflag=0 and cancel=0 group by left(e_mail_recive_bill.htmlname,15) ", GetConnect, adOpenKeyset, adLockReadOnly
If Rst1.RecordCount > 0 Then
Do Until Rst1.EOF
rstclose rst2
rst2.Open "update e_mail_recive_bill set cancel=-1 where left(e_mail_recive_bill.htmlname,15)='" & Rst1![SELLADRESSCODE] & "' and htmlname< '" & Rst1![htmlname] & "'", GetConnect(), adOpenKeyset, adLockOptimistic
Rst1.MoveNext
Loop
End If
'数据处理
rstclose rst3
rst3.Open "delete from temp_shop_stock_trans", GetConnect(), adOpenKeyset, adLockOptimistic
rstclose Rst1
Rst1.Open "select * from e_mail_recive_bill where runflag=0 and cancel=0 ", GetConnect(), adOpenKeyset, adLockOptimistic
If Rst1.RecordCount > 0 Then
rstclose rst3
rst3.Open "select * from temp_shop_stock_trans", GetConnect(), adOpenKeyset, adLockOptimistic
Do Until Rst1.EOF
Set dbfcn = GetConnect()
dbfcn.ExeCute "delete from shop_stock_trans where stockno='" & Left(Rst1![htmlname], 15) & "'"
dbcnclose cn1
cn1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=D:\X\" & Rst1![packagename] & ".mdb", "Admin", ""
rstclose rst2
rst2.Open "select * from " & Rst1![htmlname], cn1, adOpenKeyset, adLockReadOnly
If rst2.RecordCount > 0 Then
Select Case Mid(Rst1![htmlname], 9, 3)
Case "051" '进货
Do Until rst2.EOF
rst3.AddNew
rst3![StockNo] = Left(Rst1![htmlname], 15)
rst3![Date] = Format(rst2![Time], "yyyy/mm/dd")
rst3![boxcode] = NChar(rst2![boxcode])
rst3![ADDRESS] = NChar(rst2![SELLADRESSCODE])
rst3![OrderCode] = NChar(rst2![OrderCode])
rst3![Formcode] = NChar(rst2![inStock_NO])
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?