ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文
Oracle : CSV出力 for Oracle( Microsoft ODBC for Oracle ) / HTA、ADO ( No.0 )
日時: 2013/05/10 10:45
名前: lightbox



拡張子:
<SCRIPT language="VBScript">

' **********************************************************
' オブジェクト作成
' **********************************************************
Set Cn = CreateObject( "ADODB.Connection" )
Set Rs = CreateObject( "ADODB.Recordset" )
Set Fs = CreateObject( "Scripting.FileSystemObject" )
sTitle = "ADO : CSV出力 for Oracle( Microsoft ODBC for Oracle )"

Function OraAction()

	strDriver = "{Microsoft ODBC for Oracle}"
	strServer = document.getElementById("p03").value
	strUser = document.getElementById("p01").value
	strPass =  document.getElementById("p02").value
	strTable =  document.getElementById("p04").value

	ConnectionString = _
		"Provider=MSDASQL" & _
		";Driver=" & strDriver & _
		";Server=" & strServer & _
		";UID=" & strUser & _ 
		";PWD=" & strPass & _ 
		";" 

	if vbCancel = MsgBox(ConnectionString, vbOkCancel or vbDefaultButton2, sTitle ) then
		Exit Function
	end if

	' **********************************************************
	' 接続
	' **********************************************************
	on error resume next
	Cn.Open ConnectionString
	if Err.Number <> 0 then
		alert( Err.Description )
		Exit Function
	end if
	on error goto 0

	' **********************************************************
	' レコードセット取得
	' **********************************************************
	Query = "select * from " & strTable
	on error resume next
	Rs.Open Query, Cn
	if Err.Number <> 0 then
		Cn.Close
		alert( Err.Description )
		Exit Function
	end if
	on error goto 0

	' **********************************************************
	' 出力ファイルオープン
	' **********************************************************
	Set Csv = Fs.CreateTextFile( strTable & ".csv", True )

	' **********************************************************
	' タイトル出力
	' **********************************************************
	Buffer = ""
	For i = 0 to Rs.Fields.Count - 1
		if Buffer <> "" then
			Buffer = Buffer & ","
		end if
		Buffer = Buffer & Rs.Fields(i).Name
	Next
	Csv.WriteLine Buffer

	' **********************************************************
	' データ出力
	' **********************************************************
	Do While not Rs.EOF
		Buffer = ""
		For i = 0 to Rs.Fields.Count - 1
			if Buffer <> "" then
				Buffer = Buffer & ","
			end if
			Buffer = Buffer & Rs.Fields(i).Value
		Next
		Csv.WriteLine Buffer
		Rs.MoveNext
	Loop

	' **********************************************************
	' ファイルクローズ
	' **********************************************************
	Csv.Close

	' **********************************************************
	' レコードセットクローズ
	' **********************************************************
	Rs.Close

	' **********************************************************
	' 接続解除
	' **********************************************************
	Cn.Close

	Call MsgBox("処理が終了しました", 0, sTitle)

End Function

Function GetTableList()

	Dim Query

	Query=""
	Query=Query&"select TABLE_NAME from USER_TABLES "&vbCrLf
	Query=Query&"union "&vbCrLf
	Query=Query&"select VIEW_NAME from USER_VIEWS "&vbCrLf
	Query=Query&"order by TABLE_NAME "

	strDriver = "{Microsoft ODBC for Oracle}"
	strServer = document.getElementById("p03").value
	strUser = document.getElementById("p01").value
	strPass =  document.getElementById("p02").value

	ConnectionString = _
		"Provider=MSDASQL" & _
		";Driver=" & strDriver & _
		";Server=" & strServer & _
		";UID=" & strUser & _ 
		";PWD=" & strPass & _ 
		";" 

	' **********************************************************
	' 接続
	' **********************************************************
	on error resume next
	Cn.Open ConnectionString
	if Err.Number <> 0 then
		alert( Err.Description )
		Exit Function
	end if
	on error goto 0

	' **********************************************************
	' レコードセット取得
	' **********************************************************
	on error resume next
	Rs.Open Query, Cn
	if Err.Number <> 0 then
		Cn.Close
		alert( Err.Description )
		Exit Function
	end if
	on error goto 0

	' **********************************************************
	' データ作成
	' **********************************************************
	Buffer = ""
	Do While not Rs.EOF
		Buffer = Buffer & "<option value=""" & Rs.Fields(0).Value
		Buffer = Buffer & """>"
		Buffer = Buffer & Rs.Fields(0).Value
		Buffer = Buffer & "</option>"
		Rs.MoveNext
	Loop

	' **********************************************************
	' レコードセットクローズ
	' **********************************************************
	Rs.Close

	' **********************************************************
	' 接続解除
	' **********************************************************
	Cn.Close

	Dim strHTML

	strHTML = "<select id=p04>"
	strHTML = strHTML & Buffer
	strHTML = strHTML & "</select>"

	document.getElementById("table").innerHTML = strHTML

End Function

</SCRIPT>

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=shift_jis" />
<title> ADO : CSV出力 for Oracle( Microsoft ODBC for Oracle )</title>
<style type="text/css">
 * {
	font-size:14px;
}
</style>
</head>
<body>

<table id="main">
<tr>
	<td>ユーザ</td>
	<td><INPUT type="text" id="p01" value=""></td>
</tr>
<tr>
	<td>パスワード</td>
	<td><INPUT type="password" id="p02" value=""></td>
</tr>
<tr>
	<td>サーバー</td>
	<td>
		<INPUT type="text" id="p03" value="pcname/orcl">
		<INPUT type="button" value="接続してテーブル一覧を取得する" onClick='Call GetTableList()'>
	</td>
</tr>
<tr>
	<td>テーブル</td>
	<td><div id="table"><INPUT type="text" id="p04" value=""></div></td>
</tr>
<tr>
	<td><INPUT type="button" value="実行" onClick='Call OraAction()'></td>
	<td></td>
</tr>

</table>

</body>
</html>

<SCRIPT for=window event=onload language="VBScript">

	nWidth = 800
	nHeight = 600
	top.resizeTo nWidth, nHeight
	top.moveTo (screen.width-nWidth)/2, (screen.height-nHeight)/2

</SCRIPT>