拡張子:txtvbswsfjsphpjavahtmlutf8sjis <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>
<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>