|
日時: 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>
|