📄 bas_initsystreeview.bas
字号:
Attribute VB_Name = "Bas_InitSysTreeview"
'初始化系统树 - 按计划生成情况
Public Sub InitSysTree_ByPlanArrangements(STreeview As TreeView)
On Error GoTo ErrMsg
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Dim fso, txtfile
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso.CreateTextFile("tmp.txt", True)
STreeview.Nodes.Clear
Dim S0, S1, S2, S3, S4 As ADODB.Recordset
Set S0 = New ADODB.Recordset
Set S1 = New ADODB.Recordset
Set S2 = New ADODB.Recordset
Set S3 = New ADODB.Recordset
Set S4 = New ADODB.Recordset
Dim Sub_SQL, SQL_1, SQL_2, SQL_3, SQL_4 As String
Sub_SQL = "Select DatePart('yyyy',生产日期) as Syear from 生产计划 group by DatePart('yyyy',生产日期)"
If S0.State = 1 Then S0.Close
S0.Open Sub_SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S0.EOF
txtfile.Writeline S0.Fields("Syear").Value & "年"
SQL_1 = "Select DatePart('m',生产日期) AS Smonth from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' group by DatePart('m',生产日期)"
If S1.State = 1 Then S1.Close
S1.Open SQL_1, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S1.EOF
txtfile.Writeline vbTab & Format(S1.Fields("Smonth").Value, "00") & "月"
SQL_2 = "Select DatePart('d',生产日期) as Sday from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' group by DatePart('d',生产日期)"
If S2.State = 1 Then S2.Close
S2.Open SQL_2, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S2.EOF
txtfile.Writeline vbTab & vbTab & Format(S2.Fields("Sday").Value, "00") & "日"
SQL_3 = "Select 部门名称 from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' and DatePart('d',生产日期)='" & S2.Fields("Sday").Value & "' group by 部门名称"
If S3.State = 1 Then S3.Close
S3.Open SQL_3, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S3.EOF
txtfile.Writeline vbTab & vbTab & vbTab & Trim(S3.Fields("部门名称").Value)
SQL_4 = "Select 班组名称 from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' and DatePart('d',生产日期)='" & S2.Fields("Sday").Value & "' and 部门名称='" & S3.Fields("部门名称").Value & "' group by 班组名称"
If S4.State = 1 Then S4.Close
S4.Open SQL_4, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S4.EOF
txtfile.Writeline vbTab & vbTab & vbTab & vbTab & Trim(S4.Fields("班组名称").Value)
S4.MoveNext
Loop
S3.MoveNext
Loop
S2.MoveNext
Loop
S1.MoveNext
Loop
S0.MoveNext
Loop
Set fso = Nothing
txtfile.Close
OpenTreeViewFromFileWithTab "tmp.txt", STreeview, False
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Exit Sub
ErrMsg:
ErrDescription Err.Description, "Bas_InitSysTreeview", "InitSysTree_ByPlanArrangements"
End Sub
'=========================================================================================================
'初始化系统树 - 按计划单
Public Sub InitSysTree_ByPlanID(STreeview As TreeView)
On Error GoTo ErrMsg
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Dim fso, txtfile
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso.CreateTextFile("tmp.txt", True)
STreeview.Nodes.Clear
Dim S0, S1, S2, S3, S4 As ADODB.Recordset
Set S0 = New ADODB.Recordset
Set S1 = New ADODB.Recordset
Set S2 = New ADODB.Recordset
Set S3 = New ADODB.Recordset
Set S4 = New ADODB.Recordset
Dim Sub_SQL, SQL_1, SQL_2, SQL_3, SQL_4 As String
Sub_SQL = "Select DatePart('yyyy',生产日期) as Syear from 生产计划 group by DatePart('yyyy',生产日期)"
If S0.State = 1 Then S0.Close
S0.Open Sub_SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S0.EOF
txtfile.Writeline S0.Fields("Syear").Value & "年"
SQL_1 = "Select DatePart('m',生产日期) AS Smonth from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' group by DatePart('m',生产日期)"
If S1.State = 1 Then S1.Close
S1.Open SQL_1, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S1.EOF
txtfile.Writeline vbTab & Format(S1.Fields("Smonth").Value, "00") & "月"
SQL_2 = "Select 部门名称 from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' group by 部门名称"
If S2.State = 1 Then S2.Close
S2.Open SQL_2, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S2.EOF
txtfile.Writeline vbTab & vbTab & Trim(S2.Fields("部门名称").Value)
SQL_3 = "Select 计划单号,批次号 from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' and 部门名称='" & Trim(S2.Fields("部门名称").Value) & "' group by 计划单号,批次号 order by 计划单号,批次号"
If S3.State = 1 Then S3.Close
S3.Open SQL_3, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S3.EOF
txtfile.Writeline vbTab & vbTab & vbTab & Trim(S3.Fields("计划单号").Value) & Trim(S3.Fields("批次号").Value)
SQL_4 = "Select 子批次号 from 生产计划 where DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' and 部门名称='" & Trim(S2.Fields("部门名称").Value) & "' and 计划单号='" & Trim(S3.Fields("计划单号").Value) & "' and 批次号='" & Trim(S3.Fields("批次号").Value) & "' group by 子批次号 order by 子批次号"
If S4.State = 1 Then S4.Close
S4.Open SQL_4, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S4.EOF
txtfile.Writeline vbTab & vbTab & vbTab & vbTab & Trim(S4.Fields("子批次号").Value)
S4.MoveNext
Loop
S3.MoveNext
Loop
S2.MoveNext
Loop
S1.MoveNext
Loop
S0.MoveNext
Loop
Set fso = Nothing
txtfile.Close
OpenTreeViewFromFileWithTab "tmp.txt", STreeview, False
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Exit Sub
ErrMsg:
ErrDescription Err.Description, "Bas_InitSysTreeview", "InitSysTree_ByPlanID"
End Sub
'=========================================================================================================
'初始化系统树 - 按确定计划单
Public Sub InitSysTree_ByPlan(STreeview As TreeView, PlanID_7 As String)
On Error GoTo ErrMsg
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Dim fso, txtfile
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso.CreateTextFile("tmp.txt", True)
STreeview.Nodes.Clear
Dim S0, S1, S2, S3, S4 As ADODB.Recordset
Set S0 = New ADODB.Recordset
Set S1 = New ADODB.Recordset
Set S2 = New ADODB.Recordset
Set S3 = New ADODB.Recordset
Set S4 = New ADODB.Recordset
Dim Sub_SQL, SQL_1, SQL_2, SQL_3, SQL_4 As String
If PlanID_7 <> "" Then txtfile.Writeline PlanID_7
Sub_SQL = "Select 批次号 from 生产计划 where 计划单号='" & PlanID_7 & "' group by 批次号"
If S0.State = 1 Then S0.Close
S0.Open Sub_SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S0.EOF
txtfile.Writeline vbTab & PlanID_7 & S0.Fields("批次号").Value
SQL_1 = "Select 子批次号 from 生产计划 where 计划单号='" & PlanID_7 & "' and 批次号='" & S0.Fields("批次号").Value & "' group by 子批次号"
If S1.State = 1 Then S1.Close
S1.Open SQL_1, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S1.EOF
txtfile.Writeline vbTab & vbTab & Trim(S1.Fields("子批次号").Value)
S1.MoveNext
Loop
S0.MoveNext
Loop
Set fso = Nothing
txtfile.Close
OpenTreeViewFromFileWithTab "tmp.txt", STreeview, False
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Exit Sub
ErrMsg:
ErrDescription Err.Description, "Bas_InitSysTreeview", "InitSysTree_ByPlan"
End Sub
'=========================================================================================================
'初始化系统树 - 按客户名称
Public Sub InitSysTree_ByCustomer(STreeview As TreeView, Customer As String)
'On Error GoTo ErrMsg
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
STreeview.Nodes.Clear
If Customer = "" Then Exit Sub
Dim fso, txtfile
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtfile = fso.CreateTextFile("tmp.txt", True)
Dim S0, S1, S2, S3, S4 As ADODB.Recordset
Set S0 = New ADODB.Recordset
Set S1 = New ADODB.Recordset
Set S2 = New ADODB.Recordset
Set S3 = New ADODB.Recordset
Set S4 = New ADODB.Recordset
Dim Sub_SQL, SQL_1, SQL_2, SQL_3, SQL_4 As String
Sub_SQL = "Select 客户名称 from 计划信息 where 客户名称 like '%" & Customer & "%' group by 客户名称"
If rs.State = 1 Then rs.Close
rs.Open Sub_SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not rs.EOF
txtfile.Writeline PlanID_7 & rs.Fields("客户名称").Value
SQL = "Select DatePart('yyyy',生产日期) as Syear from 计划信息,生产计划 where 客户名称='" & rs.Fields("客户名称").Value & "' and 计划信息.计划单号=生产计划.计划单号 and 计划信息.批次号=生产计划.批次号 group by DatePart('yyyy',生产日期)"
If S0.State = 1 Then S1.Close
S0.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S0.EOF
txtfile.Writeline vbTab & S0.Fields("Syear").Value & "年"
SQL_1 = "Select DatePart('m',生产日期) AS Smonth from 计划信息,生产计划 where 客户名称='" & rs.Fields("客户名称").Value & "' and 计划信息.计划单号=生产计划.计划单号 and 计划信息.批次号=生产计划.批次号 and DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' group by DatePart('m',生产日期)"
If S1.State = 1 Then S1.Close
S1.Open SQL_1, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S1.EOF
txtfile.Writeline vbTab & vbTab & Format(S1.Fields("Smonth").Value, "00") & "月"
SQL_2 = "Select DatePart('d',生产日期) as Sday from 计划信息,生产计划 where 客户名称='" & rs.Fields("客户名称").Value & "' and 计划信息.计划单号=生产计划.计划单号 and 计划信息.批次号=生产计划.批次号 and DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' group by DatePart('d',生产日期)"
If S2.State = 1 Then S2.Close
S2.Open SQL_2, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S2.EOF
txtfile.Writeline vbTab & vbTab & vbTab & Format(S2.Fields("Sday").Value, "00") & "日"
SQL_3 = "Select 生产计划.计划单号,生产计划.批次号 from 计划信息,生产计划 where 客户名称='" & rs.Fields("客户名称").Value & "' and 计划信息.计划单号=生产计划.计划单号 and 计划信息.批次号=生产计划.批次号 and DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' and DatePart('d',生产日期)='" & S2.Fields("Sday").Value & "' group by 生产计划.计划单号,生产计划.批次号"
If S3.State = 1 Then S3.Close
S3.Open SQL_3, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S3.EOF
txtfile.Writeline vbTab & vbTab & vbTab & vbTab & Trim(S3.Fields("计划单号").Value) & Trim(S3.Fields("批次号").Value)
SQL_4 = "Select 生产计划.子批次号 from 计划信息,生产计划 where 生产计划.批次号='" & Trim(S3.Fields("批次号").Value) & "' and 生产计划.计划单号='" & Trim(S3.Fields("计划单号").Value) & "' and 客户名称='" & rs.Fields("客户名称").Value & "' and 计划信息.计划单号=生产计划.计划单号 and 计划信息.批次号=生产计划.批次号 and DatePart('yyyy',生产日期)='" & S0.Fields("Syear").Value & "' and DatePart('m',生产日期)='" & S1.Fields("Smonth").Value & "' and DatePart('d',生产日期)='" & S2.Fields("Sday").Value & "' group by 生产计划.子批次号"
If S4.State = 1 Then S4.Close
S4.Open SQL_4, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
Do While Not S4.EOF
txtfile.Writeline vbTab & vbTab & vbTab & vbTab & vbTab & Trim(S4.Fields("子批次号").Value)
S4.MoveNext
Loop
S3.MoveNext
Loop
S2.MoveNext
Loop
S1.MoveNext
Loop
S0.MoveNext
Loop
rs.MoveNext
Loop
Set fso = Nothing
txtfile.Close
OpenTreeViewFromFileWithTab "tmp.txt", STreeview, False
If Dir("tmp.txt") <> "" Then Kill "tmp.txt"
Exit Sub
ErrMsg:
ErrDescription Err.Description, "Bas_InitSysTreeview", "InitSysTree_ByCustomer"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -