複合化ツール作ってみました

Option Explicit

Const dbLangGeneral=";LANGID=0x0409;CP=1252;COUNTRY=0"

Dim mdb,tmplt,fso,dst,src,re,dbe,arg,fldr,fl,db,rs,qty,into,values,n,e,v,p
Dim kje023,kje176,kje178,kje179,kje180,kje181,kje182

Function Log10(X)
Log10=Log(X)/Log(10)
End Function


mdb=Replace(WScript.ScriptFullName,WScript.ScriptName,"Integrate.mdb")
tmplt=Replace(WScript.ScriptFullName,WScript.ScriptName,"AISA_TEMPLATE.xml")
Set fso=CreateObject("Scripting.FileSystemObject")
Set dst=CreateObject("MSXML2.DOMDocument")
Set src=CreateObject("MSXML2.DOMDocument")
Set re=CreateObject("VBScript.RegExp")
Set dbe=CreateObject("DAO.DBEngine.36")
For Each arg In WScript.Arguments
kje023=0
kje176=1
kje178=1
kje179=1
kje180=0
kje181=0
kje182=0
dst.load tmplt
If fso.FileExists(mdb) Then
fso.DeleteFile mdb
End If
Set db=dbe.CreateDatabase(mdb,dbLangGeneral)
re.Pattern="[\\/][^\\/]*$"
fldr=re.Replace(arg,"")
re.Pattern="^.*[\\/]"
fl=re.Replace(arg,"")
db.Execute "SELECT * INTO AIS FROM [text;Database="&fldr&"].["&fl&"]"
db.Execute "CREATE INDEX AIS ON AIS(PATH)"
db.Execute "CREATE TABLE KJA024(KJE166 text,KJE167 text,KJE168 FLOAT)"
Set rs=db.OpenRecordset("SELECT PATH,SUM(QTY) AS SUMQTY FROM AIS GROUP BY PATH")
' Set rs=db.OpenRecordset("SELECT PATH,QTY AS SUMQTY FROM AIS")
Do Until rs.Eof
src.load rs.Fields("PATH").Value
qty=rs.Fields("SUMQTY").Value
'**************
'* TOTAL INFO *
'**************
For Each n In src.selectNodes("//KJA024")
into=""
values=""
Set v=n.selectSingleNode(".//KJE166/PROPERTY_VALUE")
If Not v Is Nothing Then
into=into&"KJE166,"
values=values&""""&v.text&""","
End If
Set v=n.selectSingleNode(".//KJE167/PROPERTY_VALUE")
If Not v Is Nothing Then
into=into&"KJE167,"
values=values&""""&v.text&""","
End If
Set v=n.selectSingleNode(".//KJE168/PROPERTY_VALUE")
If Not v Is Nothing Then
e=0
Set p=v.selectSingleNode("@prefix")
If Not p Is Nothing Then
Select Case p.text
Case "m"
e=-3
Case "k"
e=3
Case Else
'WScript.Echo "ERROR:UNKNOWN PREFIX """&p.text&""""
End Select
End If
into=into&"KJE168,"
values=values&(qty*v.text*(10^e))&","
End If
db.Execute "INSERT INTO KJA024("&Left(into,Len(into)-1)&")VALUES("&Left(values,Len(values)-1)&")"
Next
'********
'* MASS *
'********
Set v=src.selectSingleNode("//KJE023/PROPERTY_VALUE")
e=0
Set p=v.selectSingleNode("@prefix")
If Not p Is Nothing Then
Select Case p.text
Case "m"
e=-3
Case "k"
e=3
Case Else
'WScript.Echo "ERROR:UNKNOWN PREFIX """&p.text&""""
End Select
End If
kje023=kje023+qty*v.text*(10^e)
'******************
'* Making to set *
'******************
With src.selectSingleNode("//KJE176/PROPERTY_VALUE")
If .text-kje176>0 Then
kje176=.text
End If
End With
'******************
'* GADSL division *
'******************
kje178=Sgn(kje178*src.selectSingleNode("//KJE178/PROPERTY_VALUE").text)
'****************
'* JIG division *
'****************
kje179=Sgn(kje179*src.selectSingleNode("//KJE179/PROPERTY_VALUE").text)
'********************
'* Content division *
'********************
kje180=Sgn(kje180+src.selectSingleNode("//KJE180/PROPERTY_VALUE").text)
'*****************
'* Material list *
'*****************
v=src.selectSingleNode("//KJE181/PROPERTY_VALUE").text
If kje181=0 Or kje181>v Then
kje181=v
End If
'******************
'* Substance list *
'******************
v=src.selectSingleNode("//KJE182/PROPERTY_VALUE").text
If kje182=0 Or kje182>v Then
kje182=v
End If
'**************
'* INTERLAYER *
'**************
For Each v In src.selectNodes("//KJE128/PROPERTY_VALUE")
With v
e=0
Set p=.selectSingleNode("@prefix")
If p Is Nothing Then
Set p=.attributes.setNamedItem(dst.createAttribute("prefix"))
p.text=""
Else
Select Case p.text
Case "m"
e=-3
Case "k"
e=3
Case Else
'WScript.Echo "ERROR:UNKNOWN PREFIX """&p.text&""""
End Select
End If
.text=.text*(10^e)
e=Sgn(Int((Log10(.text)-2)/3))*3
.text=.text/(10^e)
With p
Select Case e
Case -3
.text="m"
Case 0
.text=""
Case 3
.text="k"
End Select
End With
End With
Next
For Each v In src.selectNodes("//KJE133/PROPERTY_VALUE")
With v
e=0
Set p=.selectSingleNode("@prefix")
If p Is Nothing Then
Set p=.attributes.setNamedItem(dst.createAttribute("prefix"))
p.text=""
Else
Select Case p.text
Case "m"
e=-3
Case "k"
e=3
Case Else
'WScript.Echo "ERROR:UNKNOWN PREFIX """&p.text&""""
End Select
End If
.text=.text*(10^e)
e=Sgn(Int((Log10(.text)-2)/3))*3
.text=.text/(10^e)
With p
Select Case e
Case -3
.text="m"
Case 0
.text=""
Case 3
.text="k"
End Select
End With
End With
Next
For Each n In src.selectNodes("//KJA027")
With n
If .selectSingleNode("EDK027-001") Is Nothing Then
With .insertBefore(src.createNode(1,"EDK027-001",.namespaceURI),.selectSingleNode(".//KJA028"))
With .appendChild(src.createNode(1,"KJE055",.namespaceURI))
.attributes.setNamedItem(src.createAttribute("type")).nodeValue="String"
.attributes.setNamedItem(src.createAttribute("pub_level")).nodeValue="0"
.attributes.setNamedItem(src.createAttribute("segment")).nodeValue="KSG007"
.appendChild(src.createNode(1,"PROPERTY_SNAME",.namespaceURI)).text="Interlayer name"
.appendChild(src.createNode(1,"PROPERTY_VALUE",.namespaceURI))
End With
With .appendChild(src.createNode(1,"KJE057",.namespaceURI))
.attributes.setNamedItem(src.createAttribute("type")).nodeValue="Real"
.attributes.setNamedItem(src.createAttribute("pub_level")).nodeValue="0"
.attributes.setNamedItem(src.createAttribute("segment")).nodeValue="KSG007"
.appendChild(src.createNode(1,"PROPERTY_SNAME",.namespaceURI)).text="No of parts"
.appendChild(src.createNode(1,"PROPERTY_VALUE",.namespaceURI)).text=1
End With
With .appendChild(src.createNode(1,"KJE184",.namespaceURI))
.attributes.setNamedItem(src.createAttribute("type")).nodeValue="Int"
.attributes.setNamedItem(src.createAttribute("pub_level")).nodeValue="0"
.attributes.setNamedItem(src.createAttribute("segment")).nodeValue="KSG007"
.appendChild(src.createNode(1,"PROPERTY_SNAME",.namespaceURI)).text="Interlayer level"
.appendChild(src.createNode(1,"PROPERTY_VALUE",.namespaceURI)).text="1"
End With
End With
End If
With .selectSingleNode("EDK027-001")
With .selectSingleNode(".//KJE055/PROPERTY_VALUE")
If Len(.text) Then
re.Pattern="^(.*/)?"
.text=re.Replace(.text,"/")
End If
.text=n.selectSingleNode("//KJE172/PROPERTY_VALUE").text&.text
End With
With .selectSingleNode(".//KJE057/PROPERTY_VALUE")
.text=.text*qty
End With
End With
End With
dst.selectSingleNode("//KJA026").appendChild(n)
Next
rs.MoveNext
Loop
rs.Close
Set rs=Nothing
'**************
'* TOTAL INFO *
'**************
With dst.selectSingleNode("//KJA001")
Set rs=db.OpenRecordset("SELECT KJE166,KJE167,SUM(KJE168)AS SUM_KJE168 FROM KJA024 GROUP BY KJE166,KJE167")
Do Until rs.Eof
With.InsertBefore(dst.createNode(1,"KJA024",.namespaceURI),.selectSingleNode("KJA026"))
.appendChild(dst.createNode(1,"CLASS_NAME",.namespaceURI)).text="TOTAL INFO"
With .appendChild(dst.createNode(1,"EDK024-001",.namespaceURI))
With .appendChild(dst.createNode(1,"KJE166",.namespaceURI))
.attributes.setNamedItem(dst.createAttribute("type")).text="String"
.attributes.setNamedItem(dst.createAttribute("pub_level")).text="0"
.attributes.setNamedItem(dst.createAttribute("segment")).text="KSG003"
.appendChild(dst.createNode(1,"PROPERTY_SNAME",.namespaceURI)).text="Material name"
.appendChild(dst.createNode(1,"PROPERTY_VALUE",.namespaceURI)).text=rs.Fields("KJE166")
End With
With .appendChild(dst.createNode(1,"KJE167",.namespaceURI))
.attributes.setNamedItem(dst.createAttribute("type")).text="String"
.attributes.setNamedItem(dst.createAttribute("pub_level")).text="0"
.attributes.setNamedItem(dst.createAttribute("segment")).text="KSG003"
.appendChild(dst.createNode(1,"PROPERTY_SNAME",.namespaceURI)).text="Mat class code"
.appendChild(dst.createNode(1,"PROPERTY_VALUE",.namespaceURI)).text=rs.Fields("KJE167")
End With
With .appendChild(dst.createNode(1,"KJE168",.namespaceURI))
.attributes.setNamedItem(dst.createAttribute("type")).text="RealM"
.attributes.setNamedItem(dst.createAttribute("pub_level")).text="0"
.attributes.setNamedItem(dst.createAttribute("segment")).text="KSG003"
.appendChild(dst.createNode(1,"PROPERTY_SNAME",.namespaceURI)).text="Material mass"
With .appendChild(dst.createNode(1,"PROPERTY_VALUE",.namespaceURI))
e=Sgn(Int((Log10(rs.Fields("SUM_KJE168"))-2)/3))*3
.text=rs.Fields("SUM_KJE168")/(10^e)
With .attributes.setNamedItem(dst.createAttribute("prefix"))
Select Case e
Case -3
.text="m"
Case 0
.text=""
Case 3
.text="k"
End Select
End With
.attributes.setNamedItem(dst.createAttribute("unit")).text="g"
End With
End With
End With
End With
rs.MoveNext
Loop
rs.Close
Set rs=Nothing
End With
'********
'* MASS *
'********
With dst.selectSingleNode("//KJE023/PROPERTY_VALUE")
e=Sgn(Int((Log10(kje023)-2)/3))*3
.text=kje023/(10^e)
With .selectSingleNode("@prefix")
Select Case e
Case -3
.text="m"
Case 0
.text=""
Case 3
.text="k"
End Select
End With
.selectSingleNode("@unit").text="g"
End With
'******************
'* Making to set *
'******************
dst.selectSingleNode("//KJE176/PROPERTY_VALUE").text=kje176
'******************
'* GADSL division *
'******************
dst.selectSingleNode("//KJE178/PROPERTY_VALUE").text=kje178
'****************
'* JIG division *
'****************
dst.selectSingleNode("//KJE179/PROPERTY_VALUE").text=kje179
'********************
'* Content devision *
'********************
dst.selectSingleNode("//KJE180/PROPERTY_VALUE").text=kje180
'*****************
'* Material list *
'*****************
dst.selectSingleNode("//KJE181/PROPERTY_VALUE").text=kje181
'******************
'* Substance list *
'******************
dst.selectSingleNode("//KJE182/PROPERTY_VALUE").text=kje182
'**************
'* INTERLAYER *
'**************
If kje176=2 Then
For Each n In dst.selectNodes("//KJA030")
If n.selectNodes("KJA031").length=0 Then
n.selectSingleNode("..").removeChild(n)
End If
Next
For Each n In dst.selectNodes("//KJA029")
If n.selectNodes("KJA030").length=0 Then
n.selectSingleNode("..").removeChild(n)
End If
Next
For Each n In dst.selectNodes("//KJA028")
If n.selectNodes("KJA029").Length=0 Then
n.selectSingleNode("..").removeChild(n)
End If
Next
For Each n In dst.selectNodes("//KJA027")
If n.selectNodes("KJA028").length=0 Then
n.selectSingleNode("..").removeChild(n)
End If
Next
End If
db.Execute "DROP TABLE AIS"
db.Execute "DROP TABLE KJA024"
db.Close
Set db=Nothing
fso.DeleteFile mdb
re.Pattern="[^\.]*$"
dst.save fldr&"\AIS"&Mid("BC",kje176,1)&"_"&re.Replace(fl,"xml")
Next
Set dst=Nothing
Set src=Nothing
Set dbe=Nothing
MsgBox "FINISHED"