📄 frmwlrep.frm
字号:
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 555
Index = 2
Left = 720
TabIndex = 6
Top = 480
Width = 795
End
Begin VB.Label Label3
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 2
Left = 1680
TabIndex = 5
Top = 1440
Width = 120
End
End
Begin VB.Frame Frame1
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1935
Index = 1
Left = 240
TabIndex = 8
Top = 1920
Visible = 0 'False
Width = 6855
Begin VB.CommandButton Command2
Caption = "打开"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 4920
TabIndex = 11
Top = 1320
Width = 975
End
Begin VB.FileListBox File1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 810
Index = 0
Left = 3840
System = -1 'True
TabIndex = 10
Top = 360
Width = 2055
End
Begin VB.DirListBox Dir1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 900
Index = 0
Left = 1680
TabIndex = 9
Top = 360
Width = 2055
End
Begin VB.Label Label2
Appearance = 0 'Flat
AutoSize = -1 'True
Caption = "提示："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 240
Index = 1
Left = 720
TabIndex = 14
Top = 1440
Width = 720
End
Begin VB.Label Label1
Appearance = 0 'Flat
Caption = "路径及账套名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 555
Index = 1
Left = 720
TabIndex = 13
Top = 480
Width = 795
End
Begin VB.Label Label3
AutoSize = -1 'True
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 1
Left = 1680
TabIndex = 12
Top = 1440
Width = 120
End
End
End
Attribute VB_Name = "Frmwlrep"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim db1 As Database
Dim dbDataBase As DAO.Database
Dim tdTable As DAO.TableDef
Dim fldField As DAO.Field
Dim Test, test1, test2 As String
Dim x, y, z, s As Single
Dim rs As Recordset
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOW = 5
Dim FileSystemObject As New FileSystemObject
Private Sub Command1_Click()
Dim fs As New FileSystemObject
' Dim fs As New FileSystemObject
Dim strData() As String
Dim blnExt As Boolean
Dim i As Integer
ProgressBar1.Visible = True
ProgressBar1.Min = 0
ProgressBar1.Max = 15
On Error Resume Next
' Frmwlrep.subGetData strData, blnExt
Set db = OpenDatabase("d:\物流作业报表系统\物流仓库作业数据.mdb", False, False)
test1 = db.TableDefs("出库明细").Name
If test1 = "出库明细" Then
db.Execute ("DROP table 出库明细")
End If
db.Close
If fs.FileExists(App.Path & "\销售出库.xls") = True Then
' gadoCN.Execute "Drop table " & 仓库作业.xls
ExportExcelSheetToAccess "销售出库", App.Path & "\销售出库.xls", "出库明细", App.Path & "\物流仓库作业数据.mdb"
' Call gsubConnectDBF("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\1.mdb;Persist Security Info=False")
Else
MsgBox "数据源文件不存在！"
End If
Set db = OpenDatabase("d:\物流作业报表系统\物流仓库作业数据.mdb", False, False)
test2 = db.TableDefs("电子商务").Name
If test2 = "电子商务" Then
db.Execute ("DROP table 电子商务")
End If
db.Close
If fs.FileExists(App.Path & "\电子商务.xls") = True Then
' gadoCN.Execute "Drop table " & 仓库作业.xls
ExportExcelSheetToAccess "Sheet1 ", App.Path & "\电子商务.xls", "电子商务", App.Path & "\物流仓库作业数据.mdb"
' Call gsubConnectDBF("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\1.mdb;Persist Security Info=False")
Else
MsgBox "数据源文件不存在！"
End If
Adodc4.CommandType = adCmdText
Adodc4.RecordSource = "Select * from 电子商务"
Adodc4.Refresh
Adodc4.Recordset.MoveFirst
If IsNull(Adodc4.Recordset.Fields(1)) Then
MsgBox "导入数据格式不对，请更正源格式再试！"
GoTo abc
End If
' If blnExt = False Then
' For i = 0 To UBound(strData) - 1
Set db = OpenDatabase("d:\物流作业报表系统\物流仓库作业数据.mdb", False, False)
Test = db.TableDefs("仓库作业").Name
If Test = "仓库作业" Then
db.Execute ("DROP table 仓库作业")
End If
db.Close
If fs.FileExists(App.Path & "\仓库作业.xls") = True Then
' gadoCN.Execute "Drop table " & 仓库作业.xls
ExportExcelSheetToAccess "SHEET1", App.Path & "\仓库作业.xls", "仓库作业", App.Path & "\物流仓库作业数据.mdb"
' Call gsubConnectDBF("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\1.mdb;Persist Security Info=False")
Else
MsgBox "数据源文件不存在！"
End If
' End If
' Set dbDataBase = DAO.OpenDatabase("d:\物流作业报表系统\物流仓库作业数据.mdb", True, False, ";pwd=" & Password & ";")
Set dbDataBase = DAO.OpenDatabase("d:\物流作业报表系统\物流仓库作业数据.mdb")
Set tdTable = dbDataBase.TableDefs("仓库作业")
Set fldField = tdTable.Fields(0)
tdTable.Fields(0).Name = "f1"
Set tdTable = dbDataBase.TableDefs("出库明细")
' Set fldField = tdTable.Fields(0)
' tdTable.Fields(0).Name = "f4"
' Set fldField = tdTable.Fields(3)
' tdTable.Fields(3).Name = "f1"
' Set fldField = tdTable.Fields(4)
' tdTable.Fields(4).Name = "f2"
' Set tdTable = dbDataBase.TableDefs("电子商务")
' Set fldField = tdTable.Fields(1)
' tdTable.Fields(1).Name = "字段1"
' Adodc4.CommandType = adCmdText
' Adodc4.RecordSource = "Select * from 电子商务 where 字段1='商品代码'"
' Adodc4.Refresh
' Adodc4.Recordset.MoveFirst
' Set tdTable = dbDataBase.TableDefs("电子商务")
' Set fldField = tdTable.Fields(1)
' tdTable.Fields(1).Name = Adodc4.Recordset.Fields("字段1")
' Set fldField = tdTable.Fields(2)
' tdTable.Fields(2).Name = Adodc4.Recordset.Fields("字段2")
' For i = 3 To 15
' If IsNull(Adodc4.Recordset.Fields(i)) = False Then
' Set fldField = tdTable.Fields(i)
' tdTable.Fields(i).Name = Adodc4.Recordset.Fields(i)
' End If
' Next
Set dbDataBase = Nothing
Set db = OpenDatabase("d:\物流作业报表系统\物流仓库作业数据.mdb")
db.Execute ("delete from 数据源食品")
db.Execute ("delete from 数据源电子")
db.Execute ("insert into 数据源食品 Select * from 仓库作业 where f4>'' and f4<'阿'")
db.Execute ("insert into 数据源电子 Select * from 电子商务 where 商品代码>''and 商品代码<'阿'")
' db.Execute ("insert into 出库明细 Select * from 仓库作业 where f4>'' and f4<'阿'")
db.Execute ("update 数据源食品 set f9=0")
db.Execute ("update 数据源食品 set f10=0")
db.Close
' 电子商务进入库数据
z = 0
s = 0
Adodc5.CommandType = adCmdText
Adodc5.RecordSource = "Select * from 数据源电子 where mid(商品代码,1,5)='13054'and 入库数量 >0 or 出库数量 >0 "
Adodc5.Refresh
If Adodc5.Recordset.RecordCount() > 0 Then
Adodc5.Recordset.MoveFirst
For i = 1 To Adodc5.Recordset.RecordCount()
z = z + Val(Adodc5.Recordset.Fields("入库数量(件) "))
s = s + Val(Adodc5.Recordset.Fields("出库数量(件) "))
Adodc5.Recordset.MoveNext
Next
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = "Select * from 异动报表 where 仓库='4号库（电子）'"
Adodc2.Refresh
Adodc2.Recordset.Fields("冷饮入库") = z
Adodc2.Recordset.Fields("冷饮销售") = s
Adodc2.Recordset.Update
End If
z = 0
s = 0
Adodc5.CommandType = adCmdText
Adodc5.RecordSource = "Select * from 数据源电子 where mid(商品代码,1,5)<>'13054'and 入库数量 >0 or 出库数量 >0 "
Adodc5.Refresh
If Adodc5.Recordset.RecordCount() > 0 Then
Adodc5.Recordset.MoveFirst
For i = 1 To Adodc5.Recordset.RecordCount()
z = z + Val(Adodc5.Recordset.Fields("入库数量(件) "))
s = s + Val(Adodc5.Recordset.Fields("出库数量(件) "))
Adodc5.Recordset.MoveNext
Next
Adodc2.CommandType = adCmdText
Adodc2.RecordSource = "Select * from 异动报表 where 仓库='4号库（电子）'"
Adodc2.Refresh
Adodc2.Recordset.Fields("速冻入库") = z
Adodc2.Recordset.Fields("速冻销售") = s
Adodc2.Recordset.Update
End If
' 食品公司进入库数据
Adodc3.CommandType = adCmdText
Adodc3.RecordSource = "Select * from 出库明细 where f1>'' and f1<'阿'"
Adodc3.Refresh
If Adodc3.Recordset.RecordCount() > 0 Then
Adodc3.Recordset.MoveFirst
For i = 1 To Adodc3.Recordset.RecordCount()
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "Select * from 数据源食品 where f4='" & Adodc3.Recordset.Fields("f1") & "' and f1='出库'"
Adodc1.Refresh
If IsNull(Adodc3.Recordset.Fields("f4")) Then
Adodc1.Recordset.Fields("f9") = 0
Else
Adodc1.Recordset.Fields("f9") = Adodc3.Recordset.Fields("f4")
End If
If IsNull(Adodc3.Recordset.Fields("f5")) Then
Adodc1.Recordset.Fields("f10") = 0
Else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -