2009年06月27日


VBScript : MDB作成 / http 経由で関数ライブラリを読み込む

ローカルでも構いませんが、WEB上に functions.vbs というファイル
を作成して利用しています。
<JOB>
<SCRIPT
	language="VBScript"
	src="http://winofsql.jp/VBScript/functions.vbs"
></SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************

CreateMdb( "売上.mdb" )
if ErrorMessage <> "" then
	Wscript.Echo ErrorMessage
end if

</SCRIPT>
</JOB>

以下が functions.vbs ですが、
クォート付加
スクリプト種別の判定
文字列名称からオブシェクト作成

を使用しています
REM **********************************************************
REM ■ 動的にローディングする為の注意
REM 1) UTF-8N で保存する
REM 2) コメントは REM を使用する
REM 3) 条件式として = を使わない
REM ■ 問題回避の対策
REM .htaccess 
REM AddType "text/plain" .vbs
REM **********************************************************

REM **********************************************************
REM シングルクォートで囲む
REM **********************************************************
Function Ss( strValue )

	Ss = "'" & strValue & "'"

End Function

REM **********************************************************
REM ダブルクォートで囲む
REM **********************************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function

REM **********************************************************
REM 実行中のスクリプトのタイプ
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )

	Dim nType

	nType = 0

	if IsObject( Wscript ) then
		nType = 1
	else
		if IsObject( window ) then
			nType = 2
		else
			if IsObject( Server ) then
				nType = 3
			end if
		end if
	end if

	ScriptType = nType

End Function

REM **********************************************************
REM オブジェクト作成を WSH、IE、ASP で共通に使えるようにする
REM **********************************************************
Function GetObj( strTarget, strObjectName )

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "

	Select Case ScriptType
		Case 1
			ExecuteString = ExecuteString & _
			"WScript.CreateObject("
		Case 2
			ExecuteString = ExecuteString & _
			"CreateObject("
		Case 3
			ExecuteString = ExecuteString & _
			"Server.CreateObject("
		Case Else
			ExecuteString = ExecuteString & _
			"CreateObject("
	End Select

	ExecuteString = ExecuteString & Dd( strObjectName ) & ")"

	ExecuteGlobal ExecuteString

End Function

REM **********************************************************
REM ADOX.Catalog の取得
REM **********************************************************
Function GetAdox( )

	if not IsObject( Adox ) then
		Call GetObj( "Adox", "ADOX.Catalog" )
	end if

End Function

REM ******************************************************
REM 文字列よりグローバルスコープの変数を定義
REM ******************************************************
Function GlobalDim(str)

	Dim ExecuteString

	ExecuteString = "Dim " & str
	ExecuteGlobal ExecuteString

End Function

REM ******************************************************
REM MDB 作成
REM ******************************************************
Function CreateMdb( strPath )

	CreateMdb = True

	GetAdox

	on error resume next
	Adox.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"
	if Err.Number <> 0 then
		CreateMdb = False
		GlobalDim("ErrorMessage")
		ErrorMessage = Err.Description
	end if
	on error goto 0

End Function


関数の相互間や、グローバルスコープ等、どこからでも共通に
変数を参照可能になるように、その必要のある変数は
ExecuteGlobal ステートメントを使用して作成しています

Adox(オブジェクト) も、ErrorMessage(変数) も、グローバル
スコープで参照可能な変数となります。たとえ既にグローバルで Dim によって定義されていても、
エラーとはならず無い場合に正しく作成されます

もう何年も運用していますが特に問題は出ていません
( ネットワーク障害や DNS の問題は、http 経由という部分において支障が発生します )
■ 関連する記事
ASP : 別ドメインにある関数ライブラリを使用して Mdb を作成する
posted by at 2009-06-27 20:00 | ツール関数 | このブログの読者になる | 更新情報をチェックする