📄 frmmaildone.frm
字号:
rst3![S380] = 0
rst3![S385] = 0
rst3![S390] = 0
rst3![s395] = 0
rst3![S400] = 0
rst3![S405] = 0
rst3![S410] = 0
rst3![S415] = 0
rst3![S420] = 0
rst3![S425] = 0
rst3![S430] = 0
rst3![S435] = 0
rst3![S440] = 0
rst3![S445] = 0
rst3![S450] = 0
rst3![S455] = 0
rst3![S460] = 0
rst3![S465] = 0
rst3![S470] = 0
rst3.Fields("S" & rst2![Size]).Value = 1
rst3.Update
rst2.MoveNext
Loop
Case "057" '盘点异常
Do Until rst2.EOF
rst3.AddNew
rst3![StockNo] = Left(Rst1![htmlname], 15)
rst3![Date] = Format(rst2![countday], "yyyy/mm/dd")
rst3![ADDRESS] = cField(rst2![SELLADRESSCODE])
rst3![OrderCode] = cField(rst2![OrderCode])
rst3![PRICE] = 0
rst3![DISCOUNT] = 0
rst3![Type] = "盘点异常"
rst3![Count] = rst2![Count]
rst3![S340] = rst2![S34]
rst3![S345] = rst2![S34_]
rst3![S350] = rst2![S35]
rst3![S355] = rst2![S35_]
rst3![S360] = rst2![S36]
rst3![S365] = rst2![S36_]
rst3![S370] = rst2![S37]
rst3![S375] = rst2![S37_]
rst3![S380] = rst2![S38]
rst3![S385] = rst2![S38_]
rst3![S390] = rst2![S39]
rst3![s395] = rst2![s39_]
rst3![S400] = rst2![S40]
rst3![S405] = 0
rst3![S410] = rst2![S40_]
rst3![S415] = 0
rst3![S420] = rst2![S41]
rst3![S425] = 0
rst3![S430] = rst2![S41_]
rst3![S435] = 0
rst3![S440] = rst2![S42]
rst3![S445] = 0
rst3![S450] = 0
rst3![S455] = 0
rst3![S460] = 0
rst3![S465] = 0
rst3![S470] = 0
rst3.Update
rst2.MoveNext
Loop
End Select
End If
Rst1![runflag] = True
Rst1.Update
Rst1.MoveNext
Loop
End If
rstclose Rst1
rstclose rst2
rstclose rst3
dbcnclose cn1
Rst1.Open "stk_ShopStockTrans", GetConnect(), adOpenDynamic, , adAsyncFetch
rstclose Rst1
Rst1.Open "select * from e_mail_recive where moveflag=0", GetConnect(), adOpenKeyset, adLockOptimistic
If Rst1.RecordCount > 0 Then
Do Until Rst1.EOF
s = Dir("d:\y\" & Rst1![packagename])
If s = "" Then
Else
XX.DeleteFile "d:\y\" & Rst1![packagename]
End If
ss = Dir("d:\x\" & Rst1![packagename])
If ss <> "" Then
XX.MoveFile "d:\x\" & Rst1![packagename], "d:\y\" & Rst1![packagename]
End If
Rst1![moveflag] = True
Rst1.Update
Rst1.MoveNext
Loop
End If
Me.MousePointer = 0
rstclose Rst1
Rst1.Open "select * from e_mail_recive_bill where runflag=0 and cancel=0", GetConnect(), adOpenKeyset, adLockOptimistic
Set Me.DataGrid1.DataSource = Rst1
MsgBox "处理完成！"
End Sub
Private Sub Command3_Click()
Dim rep As frmQryReport, rptname As String
Dim temprecord As New ADODB.Recordset
Set temprecord = New Recordset
temprecord.Open " SELECT Shop_Dossier.name, Shop_Stock_Trans.Date, Shop_Stock_Trans.Type FROM Shop_Dossier RIGHT OUTER JOIN Shop_Stock_Trans ON Shop_Dossier.code = Shop_Stock_Trans.address " _
& "where [date]= '" & Format(Me.DTPicker1.Value, "yyyy-mm-dd") & "' group by Shop_Dossier.name, Shop_Stock_Trans.Date, Shop_Stock_Trans.Type ORDER BY Shop_Dossier.name, Shop_Stock_Trans.Date", GetConnect(), adOpenKeyset, adLockOptimistic
Set Me.vsSend.DataSource = temprecord
rptname = " 邮件进度表"
Set rep = New frmQryReport
rep.SetReportName rptname
rep.AddText "Head", "", "深圳珍兴鞋业有限公司|邮件进度表|^^D^^T", ""
rep.AddText "Foot", "", "|第 ^^P 页 共 ^^A 页|", ""
rep.AddFlex vsSend
rep.Show vbModal
Set temprecord = New Recordset
Set Me.vsSend.DataSource = temprecord
End Sub
Private Sub Form_Load()
Dim i As Long, j As Long, rst2 As New ADODB.Recordset
Me.MailSession.SignOn
For j = 1 To 10000
DoEvents
Next
Me.MailMessage.SessionID = Me.MailSession.SessionID
Me.vsRecive.Cols = 6
Me.vsRecive.Cell(flexcpText, 0, 1) = "标题"
Me.vsRecive.Cell(flexcpText, 0, 2) = "发信人"
Me.vsRecive.Cell(flexcpText, 0, 3) = "发信地址"
Me.vsRecive.Cell(flexcpText, 0, 4) = "发信时间"
Me.vsRecive.ColWidth(0) = 400
Me.vsRecive.ColWidth(5) = 0
Set rst2 = New Recordset
rst2.Open "select * from e_mail_recive_bill where runflag=0 and cancel=0", GetConnect(), adOpenKeyset, adLockOptimistic
Set Me.DataGrid1.DataSource = rst2
End Sub
Private Sub MailRecive_Click()
' Me.MailSession.SignOff
' Me.MailSession.DownLoadMail = True
' Me.MailSession.SignOn
' Me.MailMessage.SessionID = Me.MailSession.SessionID
TabMail_Click
End Sub
Private Sub MailReciveDone_Click()
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
s = Dir("D:\X\*.MDB")
Do Until s = ""
rstclose RZrst
RZrst.Open "select * from E_Mail_Recive where packagename='" & s & "'", GetConnect, adOpenStatic, adLockOptimistic
If RZrst.RecordCount > 0 Then
If RZrst![runflag] = True Then
XX.DeleteFile "D:\X\" & s
End If
Else
RZrst.AddNew
RZrst![packagename] = s
RZrst![recivedate] = Date
RZrst![runflag] = False
RZrst.Update
dbcnclose cn1
cn1.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=D:\X\" & s, "Admin", ""
rstclose Rst1
Rst1.Open "select * from E_Mail_Send", cn1, adOpenKeyset, adLockReadOnly
If Rst1.RecordCount > 0 Then
rstclose rst2
rst2.Open "select * from e_mail_recive_bill where packagename='" & Left(s, 8) & "'", GetConnect(), adOpenKeyset, adLockOptimistic
If rst2.RecordCount > 0 Then
Else
Do Until Rst1.EOF
rst2.AddNew
rst2![htmlname] = cField(Rst1![htmlname])
rst2![packagename] = cField(Rst1![packagename])
rst2![packageday] = Format(Rst1![packageday], "yyyy-mm-dd") '数据日期
rst2![data_packageday] = Format(Rst1![data_packageday], "yyyy-mm-dd") '数据日期
rst2![senddate] = Format(Rst1![senddate], "yyyy-mm-dd")
rst2![runflag] = False
rst2![Cancel] = False
rst2![backflag] = False
rst2![recivedate] = Date
rst2.Update
Rst1.MoveNext
Loop
End If
End If
End If
s = Dir
Loop
rstclose rst2
rst2.Open "select * from e_mail_recive_bill where runflag=0", GetConnect(), adOpenKeyset, adLockOptimistic
Set Me.DataGrid1.DataSource = rst2
Me.MousePointer = 0
End Sub
Private Sub TabMail_Click()
Dim i As Long, j As Long
If Me.TabMail.Tabs("MailRecive").Selected Then
Me.PicRecive.Visible = True
Me.PicSend.Visible = False
Me.MailMessage.FetchUnreadOnly = 0
For i = j To 20000
DoEvents
Next
On Error Resume Next
Me.MailMessage.Fetch
On Error GoTo 0
Me.vsRecive.Rows = Me.MailMessage.MsgCount + 1
For i = 1 To Me.MailMessage.MsgCount
Me.MailMessage.MsgIndex = i - 1
Me.vsRecive.Cell(flexcpText, i, 0) = i
Me.vsRecive.Cell(flexcpText, i, 1) = Me.MailMessage.MsgSubject
Me.vsRecive.Cell(flexcpText, i, 2) = Me.MailMessage.MsgOrigDisplayName
Me.vsRecive.Cell(flexcpText, i, 3) = Me.MailMessage.MsgOrigAddress
Me.vsRecive.Cell(flexcpText, i, 4) = Me.MailMessage.MsgDateReceived
Me.vsRecive.Cell(flexcpText, i, 5) = Me.MailMessage.MsgIndex
Next
vsRecive_RowColChange
Else
Me.PicRecive.Visible = False
Me.PicSend.Visible = True
End If
End Sub
Private Sub vsRecive_RowColChange()
Dim i As Long, s As String, j As Long
If Me.vsRecive.Row > 0 Then
Me.MailMessage.MsgIndex = Me.vsRecive.Cell(flexcpText, Me.vsRecive.Row, 5)
Me.MailRead.Text = Me.MailMessage.MsgNoteText
Me.MailAttList.Clear
For i = 1 To Me.MailMessage.AttachmentCount
Me.MailMessage.AttachmentIndex = i - 1
s = ""
For j = 1 To Len(Me.MailMessage.AttachmentName)
If Mid(Me.MailMessage.AttachmentName, j, 1) = "\" Then
s = ""
Else
s = s & Mid(Me.MailMessage.AttachmentName, j, 1)
End If
Next
Me.MailAttList.AddItem s
Next
Else
Me.MailRead.Text = ""
Me.MailAttList.Clear
End If
End Sub
Public Sub rstclose(rst As ADODB.Recordset)
If rst.State = adStateClosed Then
Else
rst.Close
End If
End Sub
Public Sub dbcnclose(dbcn As ADODB.Connection)
If dbcn.State = adStateClosed Then
Else
dbcn.Close
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -