Crun()
' 使用する ODBC ドライバです
strDriver = "{SQLite3 ODBC Driver}"
strMDBFile = "販売管理B.mdb"
strSQLiteFile = "hanbai.sqlite3"
' ************************************************
' 基本設定
' ************************************************
' このスクリプトが存在するディレクトリを取得
strCurDir = WScript.ScriptFullName
strCurDir = Replace( strCurDir, WScript.ScriptName, "" )
strMdbPath = strCurDir & strMDBFile
strSQLite3Path = strCurDir & strSQLiteFile
strMessage = "対象 MDB は " & strMdbPath & "です" & vbCrLf & vbCrLf
strMessage = strMessage & "↓SQLiteの環境です" & vbCrLf
strMessage = strMessage & "DB : " & strSQLite3Path & vbCrLf & vbCrLf
strMessage = strMessage & "既にテーブルが存在する場合はメッセージが出ません" & vbCrLf
strMessage = strMessage & "それ以外ではエラーメッセージが出ますが、問題ありません"
if vbCancel = MsgBox( strMessage, vbOkCancel ) then
Wscript.Quit
end if
' ************************************************
' 処理用文字列設定
' ************************************************
' MDB の接続文字列
strConnectMdb = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strMdbPath & ";"
strConnectSQLite3 = _
"Provider=MSDASQL;Driver="&strDriver&";DATABASE=" & strSQLite3Path & ";"
' ************************************************
' 初期処理
' ************************************************
Set Cn = CreateObject("ADODB.Connection")
Cn.CursorLocation = 3
Set Rs = CreateObject( "ADODB.Recordset" )
Set Cn2 = CreateObject("ADODB.Connection")
Cn2.CursorLocation = 3
Set Rs2 = CreateObject( "ADODB.Recordset" )
Rs2.LockType = 3
Cn.Open strConnectMdb
Cn2.Open strConnectSQLite3
RunSS( "pragma auto_vacuum = full" )
' ************************************************
' コード名称マスタ
' ************************************************
Query = _
"create table コード名称マスタ (" & _
" kubun INT" & _
" ,code VARCHAR(10)" & _
" ,name NVARCHAR(50)" & _
" ,num1 INT" & _
" ,num2 INT" & _
" ,cdate DATETIME" & _
" ,udate DATETIME" & _
" ,primary key(kubun,code)" & _
")"
Call SSTransfer( "コード名称マスタ", Query )
' ************************************************
' コントロールマスタ
' ************************************************
Query = _
"create table コントロールマスタ (" & _
" ckey VARCHAR(1)" & _
" ,udate DATETIME" & _
" ,uno INT" & _
" ,primary key(ckey)" & _
")"
Call SSTransfer( "コントロールマスタ", Query )
' ************************************************
' メッセージマスタ
' ************************************************
Query = _
"create table メッセージマスタ (" & _
" code VARCHAR(4)" & _
" ,message NVARCHAR(100)" & _
" ,primary key(code)" & _
")"
Call SSTransfer( "メッセージマスタ", Query )
' ************************************************
' 取引データ
' ************************************************
Query = _
"create table 取引データ (" & _
" tkubun VARCHAR(2)" & _
" ,uno INT" & _
" ,row INT" & _
" ,tdate DATETIME" & _
" ,tcode VARCHAR(4)" & _
" ,scode VARCHAR(4)" & _
" ,su INT" & _
" ,tanka単価 INT" & _
" ,kin INT" & _
" ,primary key(tkubun,uno,row)" & _
")"
Call SSTransfer( "取引データ", Query )
' ************************************************
' 商品マスタ
' ************************************************
Query = _
"create table 商品マスタ (" & _
" scode VARCHAR(4)" & _
" ,sname NVARCHAR(50)" & _
" ,ztanka INT" & _
" ,htanka INT" & _
" ,sbun VARCHAR(3)" & _
" ,skubun VARCHAR(1)" & _
" ,cdate DATETIME" & _
" ,udate DATETIME" & _
" ,primary key(scode)" & _
")"
Call SSTransfer( "商品マスタ", Query )
' ************************************************
' 商品分類マスタ
' ************************************************
Query = _
"create table 商品分類マスタ (" & _
" sbun VARCHAR(3)" & _
" ,name NVARCHAR(50)" & _
" ,cdate DATETIME" & _
" ,udate DATETIME" & _
" ,primary key(sbun)" & _
")"
Call SSTransfer( "商品分類マスタ", Query )
' ************************************************
' 得意先マスタ
' ************************************************
Query = _
"create table 得意先マスタ (" & _
" tcode VARCHAR(4)" & _
" ,tname NVARCHAR(50)" & _
" ,tkubun VARCHAR(1)" & _
" ,tanto VARCHAR(4)" & _
" ,zip VARCHAR(7)" & _
" ,ad1 NVARCHAR(100)" & _
" ,ad2 NVARCHAR(100)" & _
" ,cdate DATETIME" & _
" ,udate DATETIME" & _
" ,primary key(tcode)" & _
")"
Call SSTransfer( "得意先マスタ", Query )
' ************************************************
' 社員マスタ
' ************************************************
Query = _
"create table 社員マスタ (" & _
" scode VARCHAR(4)" & _
" ,sname NVARCHAR(50)" & _
" ,furi NVARCHAR(50)" & _
" ,syozoku VARCHAR(4)" & _
" ,sex INT" & _
" ,cdate DATETIME" & _
" ,udate DATETIME" & _
" ,kyuyo INT" & _
" ,teate INT" & _
" ,kanri VARCHAR(4)" & _
" ,primary key(scode)" & _
")"
Call SSTransfer( "社員マスタ", Query )
' ************************************************
' 郵便番号マスタ
' ************************************************
Query = _
"create table 郵便番号マスタ (" & _
" zip VARCHAR(7)" & _
" ,kana1 NVARCHAR(255)" & _
" ,kana2 NVARCHAR(255)" & _
" ,kana3 NVARCHAR(255)" & _
" ,name1 NVARCHAR(255)" & _
" ,name2 NVARCHAR(255)" & _
" ,name3 NVARCHAR(255)" & _
")"
Call SSTransfer( "郵便番号マスタ", Query )
RunSS( "drop table codename" )
RunSS("alter table コード名称マスタ rename to codename")
RunSS( "drop table control" )
RunSS("alter table コントロールマスタ rename to control")
RunSS( "drop table message" )
RunSS("alter table メッセージマスタ rename to message")
RunSS( "drop table tdata" )
RunSS("alter table 取引データ rename to tdata")
RunSS( "drop table goods" )
RunSS("alter table 商品マスタ rename to goods")
RunSS( "drop table sbun" )
RunSS("alter table 商品分類マスタ rename to sbun")
RunSS( "drop table tokui" )
RunSS("alter table 得意先マスタ rename to tokui")
RunSS( "drop table syain" )
RunSS("alter table 社員マスタ rename to syain")
RunSS( "drop table zip" )
RunSS("alter table 郵便番号マスタ rename to zip")
RunSS( "drop view v_goods" )
Query = _
"create view v_goods as" & _
" SELECT goods.scode" & _
" , goods.sname" & _
" , goods.htanka" & _
" , sbun.sbun" & _
" , sbun.name AS bunrui_name" & _
" , goods.skubun" & _
" , codename.name AS kubun_name" & _
" from" & _
" (goods LEFT JOIN sbun" & _
" ON goods.sbun = sbun.sbun" & _
" ) LEFT JOIN codename" & _
" ON goods.skubun = codename.code" & _
" where" & _
" codename.kubun = 3"
RunSS( Query )
' ************************************************
' 終了
' ************************************************
Cn2.Close
Cn.Close
Wscript.Echo "処理が終了しました"
' ************************************************
' 転送
' ************************************************
function SSTransfer( strTable, QueryCreate )
Wscript.Echo strTable & " の作成を開始します"
Dim Query
Query = "drop table " & strTable
RunSS( Query )
RunSS( QueryCreate )
Query = "select * from " & strTable
Rs.Open Query, Cn
Rs2.Open Query, Cn2
nCount = Rs.Fields.Count
Do While not Rs.EOF
Rs2.AddNew
For I = 0 to nCount - 1
Rs2.Fields(I).Value = Rs.Fields(I).value
Next
Rs2.Update
' 更新
Rs.MoveNext
Loop
Rs2.Close
Rs.Close
Wscript.Echo strTable & " の作成が終了しました"
end function
' ************************************************
' SQLLite 実行
' ************************************************
function RunSS( Query )
on error resume next
Cn2.Execute Query
if Err.Number <> 0 then
Wscript.Echo Err.Description
end if
on error goto 0
end function
' **********************************************************
' Cscript.exe で実行を強制
' ウィンドウをアクティブにし、最大化ウィンドウとして表示(3)
' Cscript.exe の実行終了後 pause で一時停止
' **********************************************************
Function Crun( )
Dim str,WshShell
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
str = WScript.ScriptFullName
Set WshShell = CreateObject( "WScript.Shell" )
strWinDir = WshShell.ExpandEnvironmentStrings("%windir%")
strParam = " "
For I = 0 to Wscript.Arguments.Count - 1
if instr(Wscript.Arguments(I), " ") < 1 then
strParam = strParam & Wscript.Arguments(I) & " "
else
strParam = strParam & Dd(Wscript.Arguments(I)) & " "
end if
Next
Call WshShell.Run( "cmd.exe /c " & strWinDir & "\SysWOW64\cscript.exe " & Dd(str) & strParam & " & pause", 3 )
WScript.Quit
end if
End Function
' **********************************************************
' 文字列を " で囲む関数
' **********************************************************
Function Dd( strValue )
Dd = """" & strValue & """"
End function