2017年04月30日


VBScript : Excel の新しいBookを作成する


' ****************************************
' 新しい Excel の Book を作成する
' ****************************************
Function NewBook( BookPath )

	Dim ExcelApp	' アプリケーション
	Dim ExcelBook	' ブック

	Set ExcelApp = CreateObject("Excel.Application")

	' 警告を出さないようにする
	ExcelApp.DisplayAlerts = False

	' ブック追加
	ExcelApp.Workbooks.Add

	' 追加したブックを取得
	Set ExcelBook = ExcelApp.Workbooks( ExcelApp.Workbooks.Count )

	on error resume next
	' 保存
	' 56 は、Excel 2007 で拡張子 .xls で保存する場合に必要
	if CLng(Left(ExcelApp.Version & "",2 )) > 11 then
		Call ExcelBook.SaveAs( BookPath, 56 )
	else
		Call ExcelBook.SaveAs( BookPath )
	end if
	if Err.Number <> 0 then
		MsgBox( "ERROR:" & Err.Description )
	end if
	on error goto 0

	' Excel をアプリケーションとして終了
	ExcelApp.Quit
	' Excel を VBScript から開放
	Set ExcelApp = Nothing
	' オブジェクト変数を通常変数として初期化
	' ( ExcelApp がローカル変数なので実際は必要ありません )
	ExcelApp = Empty

End Function

関連する Microsoft のドキュメント

XlFileFormat Enumeration [Excel 2007 Developer Reference]

▼ オンラインライブラリでのテストコード
<JOB>
<SCRIPT language="VBScript" src="http://lightbox.on.coocan.jp/webwsh/GetScriptDir.txt"></SCRIPT>
<SCRIPT language="VBScript" src="http://lightbox.on.coocan.jp/webwsh/NewBook.txt"></SCRIPT>

<SCRIPT language=VBScript>
' ************************************
' 処理開始
' ************************************

	NewBook( GetScriptDir() & "\新しいBOOK.xls" )

</SCRIPT>
</JOB>

http://lightbox.on.coocan.jp/webwsh/GetScriptDir.txt
http://lightbox.on.coocan.jp/webwsh/NewBook.txt

関連する記事

VBScript : Excel のバージョン表示



posted by at 2017-04-30 21:29 | ツール関数 | このブログの読者になる | 更新情報をチェックする

2014年11月28日


JScript : ディレクトリ選択

4番目の引数は省略できますが、その場合は以下のようになります



var Shell = new ActiveXObject("Shell.Application");
var objFolder = Shell.BrowseForFolder( 0, "フォルダ選択", 0x4B, 0x5 );
if ( objFolder == null ) {
	WScript.Quit();
}
if ( !objFolder.Self.IsFileSystem ) {
	WScript.Echo("ファイルシステムではありません" );
	WScript.Quit();
}

WScript.Echo( objFolder.Self.Path );

関連する記事

VBScript : ディレクトリ選択



typedef enum {
	ssfALTSTARTUP = 0x1d,
	ssfAPPDATA = 0x1a,
	ssfBITBUCKET = 0x0a,
	ssfCOMMONALTSTARTUP = 0x1e,
	ssfCOMMONAPPDATA = 0x23,
	ssfCOMMONDESKTOPDIR = 0x19,
	ssfCOMMONFAVORITES = 0x1f,
	ssfCOMMONPROGRAMS = 0x17,
	ssfCOMMONSTARTMENU = 0x16,
	ssfCOMMONSTARTUP = 0x18,
	ssfCONTROLS = 0x03,
	ssfCOOKIES = 0x21,
	ssfDESKTOP = 0x00,
	ssfDESKTOPDIRECTORY = 0x10,
	ssfDRIVES = 0x11,
	ssfFAVORITES = 0x06,
	ssfFONTS = 0x14,
	ssfHISTORY = 0x22,
	ssfINTERNETCACHE = 0x20,
	ssfLOCALAPPDATA = 0x1c,
	ssfMYPICTURES = 0x27,
	ssfNETHOOD = 0x13,
	ssfNETWORK = 0x12,
	ssfPERSONAL = 0x05,
	ssfPRINTERS = 0x04,
	ssfPRINTHOOD = 0x1b,
	ssfPROFILE = 0x28,
	ssfPROGRAMFILES = 0x26,
	ssfPROGRAMFILESx86 = 0x30,
	ssfPROGRAMS = 0x02,
	ssfRECENT = 0x08,
	ssfSENDTO = 0x09,
	ssfSTARTMENU = 0x0b,
	ssfSTARTUP = 0x07,
	ssfSYSTEM = 0x25,
	ssfSYSTEMx86 = 0x29,
	ssfTEMPLATES = 0x15,
	ssfWINDOWS = 0x24
} ShellSpecialFolderConstants;




posted by at 2014-11-28 03:02 | ツール関数 | このブログの読者になる | 更新情報をチェックする

2010年04月14日


VBScript : 3メガバイト以下のWEB上のバイナリのダウンロード

比較的小さいファイルをダウンロードするのに問題無く使えます。
( 3メガバイトを超えるようなファイルは別の方法を検討します。)
Function HTTPDownload( strUrl, strPath )

	Dim objSrvHTTP,Stream

	Set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.3.0")
	Set Stream = CreateObject("ADODB.Stream")

	HTTPDownload = True

	on error resume next
	Call objSrvHTTP.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		HTTPDownload = False
		Exit Function
	end if
	on error goto 0

	objSrvHTTP.Send

	Stream.Open
	Stream.Type = 1	' バイナリ
	Stream.Write objSrvHTTP.responseBody
	Stream.SaveToFile strPath, 2
	Stream.Close

End Function

関連する記事

WEBのファイルをコマンドラインからダウンロードするスクリプト
 : httpget.vbs ( 2〜3メガまでが目安 )


タグ:XMLHTTP stream
posted by at 2010-04-14 14:48 | ツール関数 | このブログの読者になる | 更新情報をチェックする

2010年03月24日


レジストリエディタを指定したキーを選択させて実行する

VISTA からレジストリ内での名前が変更されています。そのために
GetOSVersion 関数が必要になります。元々、regedit は、一つの
プロセスしか起動できないので、終了させるのは容易です。

※ 一旦終了させないと、この選択は起動時にしか行われません
OpenReg( "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run" )

Function OpenReg( strReg )

	Dim str1
	Dim str2
	Dim Wmi 
	Dim colTarget 
	Dim objRow
	Dim WshShell

	Set WshShell = CreateObject( "WScript.Shell" )

	str1 = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"

	if GetOSVersion() > 5 then
		str2 = "コンピュータ\" & strReg
	else
		str2 = "マイ コンピュータ\" & strReg
	end if

	WshShell.RegWrite "HKCU\" & str1, str2, "REG_SZ"

	strComputer = "."
	Set Wmi = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

	Set colTarget = Wmi.ExecQuery _ 
		("Select * from Win32_Process Where Name = 'regedit.exe'")

	For Each objRow in colTarget 
		objRow.Terminate() 
	Next 

	Call WshShell.Run( "regedit" )

End Function

関連する記事

VBScript : 数値として比較できる OS のバージョンの取得


posted by at 2010-03-24 18:30 | ツール関数 | このブログの読者になる | 更新情報をチェックする

2009年06月27日


VBScript : MDB作成 / http 経由で関数ライブラリを読み込む

ローカルでも構いませんが、WEB上に functions.vbs というファイル
を作成して利用しています。
<JOB>
<SCRIPT
	language="VBScript"
	src="http://winofsql.jp/VBScript/functions.vbs"
></SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************

CreateMdb( "売上.mdb" )
if ErrorMessage <> "" then
	Wscript.Echo ErrorMessage
end if

</SCRIPT>
</JOB>

以下が functions.vbs ですが、
クォート付加
スクリプト種別の判定
文字列名称からオブシェクト作成

を使用しています
REM **********************************************************
REM ■ 動的にローディングする為の注意
REM 1) UTF-8N で保存する
REM 2) コメントは REM を使用する
REM 3) 条件式として = を使わない
REM ■ 問題回避の対策
REM .htaccess 
REM AddType "text/plain" .vbs
REM **********************************************************

REM **********************************************************
REM シングルクォートで囲む
REM **********************************************************
Function Ss( strValue )

	Ss = "'" & strValue & "'"

End Function

REM **********************************************************
REM ダブルクォートで囲む
REM **********************************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function

REM **********************************************************
REM 実行中のスクリプトのタイプ
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )

	Dim nType

	nType = 0

	if IsObject( Wscript ) then
		nType = 1
	else
		if IsObject( window ) then
			nType = 2
		else
			if IsObject( Server ) then
				nType = 3
			end if
		end if
	end if

	ScriptType = nType

End Function

REM **********************************************************
REM オブジェクト作成を WSH、IE、ASP で共通に使えるようにする
REM **********************************************************
Function GetObj( strTarget, strObjectName )

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "

	Select Case ScriptType
		Case 1
			ExecuteString = ExecuteString & _
			"WScript.CreateObject("
		Case 2
			ExecuteString = ExecuteString & _
			"CreateObject("
		Case 3
			ExecuteString = ExecuteString & _
			"Server.CreateObject("
		Case Else
			ExecuteString = ExecuteString & _
			"CreateObject("
	End Select

	ExecuteString = ExecuteString & Dd( strObjectName ) & ")"

	ExecuteGlobal ExecuteString

End Function

REM **********************************************************
REM ADOX.Catalog の取得
REM **********************************************************
Function GetAdox( )

	if not IsObject( Adox ) then
		Call GetObj( "Adox", "ADOX.Catalog" )
	end if

End Function

REM ******************************************************
REM 文字列よりグローバルスコープの変数を定義
REM ******************************************************
Function GlobalDim(str)

	Dim ExecuteString

	ExecuteString = "Dim " & str
	ExecuteGlobal ExecuteString

End Function

REM ******************************************************
REM MDB 作成
REM ******************************************************
Function CreateMdb( strPath )

	CreateMdb = True

	GetAdox

	on error resume next
	Adox.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"
	if Err.Number <> 0 then
		CreateMdb = False
		GlobalDim("ErrorMessage")
		ErrorMessage = Err.Description
	end if
	on error goto 0

End Function


関数の相互間や、グローバルスコープ等、どこからでも共通に
変数を参照可能になるように、その必要のある変数は
ExecuteGlobal ステートメントを使用して作成しています

Adox(オブジェクト) も、ErrorMessage(変数) も、グローバル
スコープで参照可能な変数となります。たとえ既にグローバルで Dim によって定義されていても、
エラーとはならず無い場合に正しく作成されます

もう何年も運用していますが特に問題は出ていません
( ネットワーク障害や DNS の問題は、http 経由という部分において支障が発生します )
■ 関連する記事
ASP : 別ドメインにある関数ライブラリを使用して Mdb を作成する
posted by at 2009-06-27 20:00 | ツール関数 | このブログの読者になる | 更新情報をチェックする