ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文
MDBを媒体としたSQLServerからExcelへのデータエクスポート
日時: 2009/04/03 17:09
名前: lightbox



<SCRIPT language=VBScript>

' **********************************************************
' 先頭に VBScript 用のタグを記述すると、デフォルトが
' VBScript になる
' **********************************************************
Set Fso = CreateObject( "Scripting.FileSystemObject" )
Set Cn = CreateObject( "ADODB.Connection" )
Cn.CursorLocation = 3
Set Adox = CreateObject( "ADOX.Catalog" )
Set Shell = CreateObject( "Shell.Application" )

Function CsvOut( nType )

	if not confirm( "Excel データを取得しますか?   " ) then
		Exit Function
	end if

	Dim obj

' ディレクトリ選択
	Set obj = Shell.BrowseForFolder( 0, "出力先のディレクトリを選択して下さい", 11+&H40, 0 )
	if obj is nothing then
		Exit Function
	end if
	if not obj.Self.IsFileSystem then
		alert( "ファイルシステムではありません   " )
		Exit Function
	end if

	SelectDir = obj.Self.Path

' &H28 は、Profile
	Set objFolder = Shell.Namespace(&H28)
	Set objFolderItem = objFolder.Self
	strPath = objFolderItem.Path & "\Local Settings\Temp\dummy.mdb"

	strOutTarget = SelectDir & "\出力_"&nType&".xls"

' 以前のファイルを削除
	on error resume next 
	Fso.DeleteFile(strPath)
	Fso.DeleteFile(strOutTarget)
	on error goto 0

' CSV 出力媒体としての MDB 作成
	on error resume next
	Adox.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"
	if Err.Number <> 0 then
'		alert(strPath & " : " & Err.Description)
'		Exit Function
	end if
	on error goto 0

' MDB 接続用
	ConnectionString = _
		"Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"

' MDB 接続
	on error resume next
	Cn.Open ConnectionString
	if Err.Number <> 0 then
		Wscript.Echo Err.Description
		Wscript.Quit
	end if
	on error goto 0


' 出力_n.xls の中に 出力データn というシートが作成される
	Query=""
	Query=Query&"select * "&vbCrLf
	Query = Query & " into [Excel 8.0;DATABASE=" & strOutTarget & "].[出力データ"&nType&"] "
	Query = Query & " from [ODBC;Driver={SQL Server};SERVER=layla;Database=isdb;UID=sa;PWD=].[V_EXCELOUT2]"

	if nType = 1 then
		Query=Query&" where  "&vbCrLf
		Query=Query&"	対象 = '" & nType & "' "&vbCrLf
	end if
	if nType = 2 then
		Query=Query&" where  "&vbCrLf
		Query=Query&"	対象 = '" & nType & "' "&vbCrLf
	end if

	Query = Query & "  order by 氏名"

	Cn.Execute Query

	alert("処理が終了しました   ")

End Function

</SCRIPT>
<SCRIPT language=JavaScript>


</SCRIPT>

<HTML>
<HEAD>
	<META http-equiv="Content-type" content="text/html; charset=Shift_JIS">
	<TITLE>CSV 出力</TITLE>
	<LINK rel="stylesheet" type="text/css" href="../style.css">
</HEAD>
<STYLE type="text/css">
INPUT {
	width:150px;
}
</STYLE>

<!-- *******************************************************
 ドキュメント
******************************************************** -->
<BODY>

<INPUT type="button" value="出力1" onClick='Call CsvOut(1)'>
<br><br>
<INPUT type="button" value="出力2" onClick='Call CsvOut(2)'>
<br><br>


</BODY>
</HTML>
メンテナンス


日時: 2009/04/03 17:09
名前: lightbox