SQLの窓

2018年12月26日


IE11 から VBScript で ODBCで使用されるデータベース(例えばSQLServer) より Excel でデータをエクスポートする

Microsoft.Jet.OLEDB.4.0 を使用したいので、IE11 を 32 ビットで動作させる事が必要です。Access も Excel も古い拡張子を使用していますが、基本的に昔の処理ですし、Microsoft に邪魔されたく無い( 何勝手にするか解らない )ので、そうしています。

エクスポート用の SQL を使用する為に、接続は Access で行って、Access 内で可能な参照方法(修飾のようなもの)を用いて、SQLServer と Excel に動的にアクセスしています。

IE11 を 32 ビットで動作させる

通常、IE11 は 32ビットで動作しているはずですが、確認の為にF12 キーで開発者ツールを表示させて、コンソールタブに移動します。次に、navigator.userAgent と入力して表示された文字列の中に WOW64 の文字列があれば、32ビットで動作しています。

もし無ければ、64ビットで動作しているので、『インターネットオプション』の『詳細設定』のセキュリティで、【拡張保護モードで 64 ビット プロセッサを有効にする】と【拡張保護モードを有効にする】のチェックを外します。

※ 拡張保護モードに関する詳細は、Microsoft のこちら( E10 & IE11 : 拡張保護モードの実態 )から参照できます。

実行する URL を信頼するサイトに登録



レベルのカスタマイズで、『スクリプトを実行しても安全だとマークされていないActiveX コントロール』を『有効』 にして、『ドメイン間のデータソースのアクセス』も有効にします
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2]
"1201"=dword:00000000
"1406"=dword:00000000


※ 関連する Microsoft ドキュメント(上級ユーザー向けの Internet Explorer セキュリティ ゾーン関連のレジストリ エントリ)
※ IEのセキュリティゾーン関連のレジストリエントリ


IE11 を IE10 として実行してエクスポート
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="X-UA-Compatible" content="IE=10">
<meta http-equiv="Content-type" content="text/html; charset=shift_jis">
<script language="VBScript">

' ***********************
' 必要なオブジェクト作成
' ***********************
on error resume next

' ファイル削除用
Set Fso = CreateObject( "Scripting.FileSystemObject" )
if Err.Number <> 0 then
	alert("Fso:"&Err.Description)
end if

' エクスポート実行用
Set Cn = CreateObject( "ADODB.Connection" )
if Err.Number <> 0 then
	alert("Cn:"&Err.Description)
end if
Cn.CursorLocation = 3

' ダミー Access 作成用
Set Adox = CreateObject( "ADOX.Catalog" )
if Err.Number <> 0 then
	alert("Adox:"&Err.Description)
end if

' ディレクトリ参照と OS パス取得用
Set Shell = CreateObject( "Shell.Application" )
if Err.Number <> 0 then
	alert("Shell:"&Err.Description)
end if
on error goto 0

Function Export()

	' ***********************
	' 2回目の実行
	' ***********************
	if Cn is nothing then
		Set Cn = CreateObject( "ADODB.Connection" )
		Cn.CursorLocation = 3
	end if

	' ***********************
	' 実行確認
	' ***********************
	if not confirm( "エクスポートを実行しますか?" ) then
		Exit Function
	end if

	Dim obj

	' ***********************
	' ディレクトリ選択
	' フラグは https://docs.microsoft.com/ja-jp/windows/desktop/api/shlobj_core/ns-shlobj_core-_browseinfoa
	' ***********************
	on error resume next 
	Set obj = Shell.BrowseForFolder( 0, "出力先のディレクトリを選択して下さい", 11+&H40, 0 )
	if Err.Number <> 0 then
		alert(Err.Description)
	end if
	on error goto 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

	' ***********************
	' ダミー用のパス
	' C:\Users\lightbox\AppData\Temp\dummy.mdb
	' ***********************
	Set objFolder = Shell.Namespace(&H1c)
	Set objFolderItem = objFolder.Self
	strPath = objFolderItem.Path & "\Temp\dummy.mdb"

	' ***********************
	' 既存のダミー削除
	' ***********************
	on error resume next 
	Fso.DeleteFile(strPath)
	on error goto 0

	' ***********************
	' 出力 Excel 削除
	' ***********************
	on error resume next 
	Fso.DeleteFile(SelectDir & "\Export.xls")
	on error goto 0

	' ***********************
	' ダミー用 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)
	end if
	on error goto 0

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

	on error resume next
	Cn.Open ConnectionString
	if Err.Number <> 0 then
		alert(ConnectionString & " : " & Err.Description)
		Exit Function
	end if
	on error goto 0

	' ***********************
	' エクスポート用 SQL
	' ***********************
	Query = "select * "
	Query = Query & "into [Excel 8.0;DATABASE=" & SelectDir & "\Export.xls].[出力データ] "
	Query = Query & " from [ODBC;Driver={SQL Server};SERVER=サーバ;Database=データベース;UID=sa;PWD=パスワード].テーブル名"

	on error resume next
	Cn.Execute Query
	if Err.Number <> 0 then
		Call Cn.Close()
		alert(Err.Description)
		Exit Function
	end if
	on error goto 0

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

	Call Cn.Close()

	Set Cn = Nothing

End Function

</script>
</head>
<body>
<input id="export" type="button" value="エクスポート" language="VBScript" onclick="Call Export()">
</body>
</html>


本当は、このページを window.open で開けて、終了したら close させます。そうすれば、dummy.mdb がアプリケーションから解放されます。


補足

Windows7 で実際に運用しているコードです。Windows10 に完全対応する為に、今回コードを整備して Windows10 でテストを行いました。この次の段階としては、VBScript やめて JScript で書いて処理します( そうすると、jQuery 使えますし )





【IEの最新記事】
posted by lightbox at 2018-12-26 14:36 | IE | このブログの読者になる | 更新情報をチェックする
container 終わり

フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり