SQLの窓

2017年09月03日


VBScript : 既存の Excel を PDF に変換する ( Excel 2007以降 )



Excel 2007以降の Excelで名前を付けて保存で PDF に保存できますが、これはスクリプトで行うコードです。Excel 2007 を調べているとメソッド紹介されていたので、引数見た限り、 VBScriptでも動くだろうと試してみました。
( プリンタが使える状態でないと動作しません )

ExportAsFixedFormat メソッド

XlFixedFormatType

最近は、VBScript の単純コードである .vbs は Google Chrome での扱いが悪いので、.wsf で作成しています。もともと、.wsf のほうが簡単に外部ライブラリを参照したり、オブジェクトを最初から定義できるのでコードが簡潔になります。ここでは、Excel.Application 内で定義されている定数も参照して使えるようにしています。

Excel 側では、印刷設定により一行目のタイトルを常に表示するようにしたり、A4 横にして縮小したりしています。シートは二つありますが、PDF に変換すると全て出力されます。
<JOB>
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<OBJECT id="ExcelApp" progid="Excel.Application" />
<REFERENCE guid="00020813-0000-0000-C000-000000000046" />
<SCRIPT language="VBScript">
' Wscript.Echo xlTypePDF,xlTypeXPS
Dim strTarget : strTarget = "販売管理B.xlsx"

' **************************************
' スクリプトのあるディレクトリの取得
' **************************************
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

Dim MyBook

on error resume next
' Workbook を取得( スクリプトと同じディレクトリ )
Set MyBook = ExcelApp.Workbooks.Open( strCurPath & "\" & strTarget )
if Err.Number <> 0 then
	' 終了( 開放 )
	ExcelApp.Quit()
	Wscript.Echo Err.Description & vbCrLf & strCurPath
	' スクリプト終了
	Wscript.Quit()
end if
on error goto 0

Call MyBook.ExportAsFixedFormat( xlTypePDF, strCurPath & "\test.pdf" )

' 終了( 開放 )
ExcelApp.Quit()

' 終了確認
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>


Microsoft の英文の記事

Saving Workbooks to PDF and XPS Formats in Excel 2007



タグ:VBScript EXCEL PDF
posted by lightbox at 2017-09-03 14:15 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

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

Excel 2007 以降の場合

VBScript : Excel の新しいBookを作成する
2007 以降の場合、.xls の拡張子で保存時はフォーマットを指定しないと読みだす時に警告が出るようです

サンプルは、.xlsx で保存しています

通常イントラネットのWEBページで利用されるテクニックの基本的な部分です。イントラネットの場合は、フォーマットを事前に作成しておくので、Excel ブックの作成を行う事は稀ですが、簡単な運用に使う場合は新規にブックが必要になると思います

※ 複数回実行すると上書きされます

Excel.Application を初回のみ作成するように記述しているのは、関数化するとこのような記述がいずれ都合が良くなるからです。

昔から、Excel.Application の扱いはけっこう厄介で、実行する毎に Quit しておくとトラブルを最低限に抑える事ができます。しかし、操作方法のルールとリカバリ方法をマニュアル化しておく事が最も重要になります
' **********************************************************
' 新しい Excel の Book を作成する
' **********************************************************

Dim ExcelApp	' アプリケーション
Dim ExcelBook	' ブック
Dim Fso		' ファイルシステムオブジェクト

' このスクリプトが存在するディレクトリ
Set Fso = CreateObject( "Scripting.FileSystemObject" )
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

' このディレクトリに作成
Dim BookPath : BookPath = strCurPath & "\mybook.xlsx"

' 初回のみオブジェクトを作成
If Not IsObject(ExcelApp) Then
	Set ExcelApp = CreateObject("Excel.Application")
End If

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

' ブック追加
ExcelApp.Workbooks.Add

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

on error resume next
' 保存
ExcelBook.SaveAs( BookPath )
if Err.Number <> 0 then
	MsgBox( "ERROR:" & Err.Description )
end if
on error goto 0

' Excel をアプリケーションとして終了
ExcelApp.Quit
' Excel を VBScript から開放
Set ExcelApp = Nothing
' オブジェクト変数を初期化( 初期化しないとオブジェクト扱いされる )
ExcelApp = Empty




タグ:VBScript EXCEL
posted by lightbox at 2017-09-03 14:09 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2015年03月25日


ブラウザ上にあるデータを PHP で受け取って、VBScript のコードを作成して事前に作成済のテンプレート Excel にデータをロードして印刷で使用する

ブラウザ上のデータ

ブラウザ上は UTF-8 である事を想定しています。Shift_JIS のページからでは VBScript では変換しづらい文字が送られる可能性があります。UTF-8 のページかあるいは、『accept-charset="UTF-8"』を属性にもつ FORM 要素を使って、PHP に UTF-8 でデータを出力します。

VBScript を UTF-8 で作成

Windows の VBScript で ファイルを UTF-8 にする場合は、BOM が先頭に付加されたファイルである必要があります。( これが無いものは UTF-8N と呼ばれています )。なので、PHP で chr(0xef) と chr(0xbb) と chr(0xbf) を先頭で出力しています

Excel の処理

Excel 関連の関数はあらかじめ埋め込んであります。VBScript に対してのデータのインターフェイスは RESOURCE 要素内に $_POST データを \r\n( 行 ) を区切り文字にして並べています。このデータを配列に変換して、Excel の特定のシートに縦に並べます。

テンプレート Excel は、そのデータを参照して別のシートに印刷フォーマットを作成してあります。Excel のテンプレートとこの .wsf ファイルを同じフォルダにダウンロードしてスクリプトを実行すると、デスクトップに Excel が開いて後は印字するだけとなります
<?php
$file = 'excel.wsf';

header('Content-Type: application/octet-stream');
header('Content-Disposition: attachment; filename='.basename($file));
header('Expires: 0');
header('Cache-Control: must-revalidate');
header('Pragma: public');

print chr(0xef);
print chr(0xbb);
print chr(0xbf);
?>
<JOB>
<COMMENT>
********************************************
※ COMMENT 要素内はコメントです
********************************************
</COMMENT>

<OBJECT id="ExcelApp" progid="Excel.Application" />
<OBJECT id="Wsh" progid="WScript.Shell" />
<OBJECT id="FileSystem" progid="Scripting.FileSystemObject" />

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

' ソース内テキストデータの取得
aData = Split( RegTrim(GetResource("myTextData")), vbCrLf )

' 変数定義( 必須ではありません )
Dim MyBook,TargetSheet,TargetExcel,ExcelFile,TargetName,PrintSheet

' テンプレート Excel ブックのパス
' 基本的には、カレントを使用するほうが良いでしょう
ExcelFile = Replace( aData(0), "\\", "\" )
' データ作成用の対象者の日本語名( 余計なスペースを省いています )
TargetName = Replace( aData(1), " ", "" )
TargetName = Replace( TargetName, " ", "" )
' データをセットするシート名
TargetSheet = aData(2)
' 印字するシート名
PrintSheet = aData(3)

' テンプレート Excel から作成する新しいブックファイル名
TargetExcel = Replace(LCase(ExcelFile), ".xlsx", "" ) & "_" & TargetName & ".xlsx"

' コピーして作成
FileSystem.CopyFile ExcelFile, TargetExcel, True

' Excel 読み込み
Set MyBook = ExcelOpen( TargetExcel )

' シート選択
Call ExcelSelectSheet(MyBook, TargetSheet)

' 印字情報の一覧 ( aData(4) 〜 )
For I = 4 to Ubound(aData)
	Call ExcelSetCell(MyBook, TargetSheet, 2, I-3, aData(I) )
Next

Call ExcelSelectSheet(MyBook, PrintSheet)
Call ExcelSave(MyBook)
Call ExcelQuit(MyBook)

LoadExcel( TargetExcel )

'*******************************************
' 文字列前後の漢字スペースを含むホワイトスペースの削除
'*******************************************
Function RegTrim( strValue )

	Dim regEx, str

	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "^[ \s]+"
	str = regEx.Replace( strValue, "" )
	regEx.Pattern = "[ \s]+$"
	RegTrim = regEx.Replace( str, "" )

End Function

' ******************************************************
' ブックを デスクトップに開く
' ******************************************************
Function LoadExcel(strPath)

	Call Wsh.Run( "RunDLL32.EXE url.dll,FileProtocolHandler " & _
		strPath )

End Function

' ******************************************************
' ブックを開く(Workbookを返す)
' ******************************************************
Function ExcelOpen(strPath)

	Set ExcelOpen = ExcelApp.Workbooks.Open(strPath)
	
	' アクティブなウィンドウを最大化
	ExcelApp.ActiveWindow.WindowState = 2

End Function

' ******************************************************
' 表示状態の変更
' ******************************************************
Function ExcelVisible(bFlg)

	ExcelApp.Visible = bFlg

End Function

' ******************************************************
' 終了
' ******************************************************
Function ExcelQuit(WorkBook)

	If TypeName(WorkBook) = "Workbook" Then
		' 保存した事にする
		WorkBook.Saved = True
	End If
	If IsObject(ExcelApp) Then
		ExcelApp.Quit
	End If

End Function

' ******************************************************
' シート名によるシート選択
' ******************************************************
Function ExcelSelectSheet(MyBook, strSheetName)

	MyBook.Sheets(strSheetName).Select

End Function

' ******************************************************
' 番号よるシート選択
' ******************************************************
Function ExcelSelectSheetByNo(MyBook, No)

	MyBook.Sheets(No).Select

End Function

' ******************************************************
' シート名によるシート複写
' ******************************************************
Function ExcelCopySheet(MyBook, strSheetName, strNewSheetName)

	MyBook.Sheets(strSheetName).Copy (MyBook.Sheets(strSheetName))
	MyBook.ActiveSheet.Name = strNewSheetName

End Function

' ******************************************************
' シート名によるシート名変更
' ******************************************************
Function ExcelRenameSheet(MyBook, strSheetName, strNewSheetName)

	MyBook.Sheets(strSheetName).Name = strNewSheetName

End Function

' ******************************************************
' 上書き保存
' ******************************************************
Function ExcelSave(MyBook)

	MyBook.Save

End Function

' ******************************************************
' 名前を付けて保存
' ******************************************************
Function ExcelSaveAs(MyBook, strFileName)

	MyBook.SaveAs strFileName

End Function

' ******************************************************
' セルへのデータセット
' ******************************************************
Function ExcelSetCell(MyBook, strSheetName, x, y, Data)

	MyBook.Sheets(strSheetName).Cells(y, x) = Data

End Function

' ******************************************************
' セルへのフォントサイズセット
' ******************************************************
Function ExcelSetCellFontSize(MyBook, strSheetName, x, y, Data)

	MyBook.Sheets(strSheetName).Cells(y, x).Font.Size = Data

End Function

' ******************************************************
' シートの数
' ******************************************************
Function ExcelGetSheetCount(MyBook)

	ExcelGetSheetCount = MyBook.Sheets.Count

End Function

' ******************************************************
' 列の自動調整
' ******************************************************
Function ExcelAutofit(MyBook,strSheetName)

	MyBook.Worksheets(strSheetName).UsedRange.EntireColumn.Autofit()

End Function
</SCRIPT>

<COMMENT>
********************************************
 ソース内テキストデータ
********************************************
</COMMENT>
<RESOURCE id="myTextData">
<![CDATA[
<?php
	foreach( $_POST as $key => $val ) {
		print $_POST[$key] . "\r\n";
	}
?>
]]>
</RESOURCE>

</JOB>

この処理はもともと、IE 上に表示されたデータを IE上のスクリプトとして VBScript を使用し、Excel.Application で Excel を使って印刷処理を実装していたものです。今でも利用していますが、今後の将来を考えると、Google Chrome でも使用可能にする為にスクリプトをダウンロードさせる形式を作ってみました。

ダウンロードした Excel ブックのパス(テンプレート)はセキュリティ上の問題で取得できませんが、社内であればネットワーク上に置いておけば固定のパスとして利用可能だと思います。




タグ:EXCEL VBScript PHP
posted by lightbox at 2015-03-25 15:09 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2015年02月24日


VBScript : Access のテーブルを TransferText メソッドを使用して UTF-8 で CSV または HTML にして出力する



syain.html

Microsoft ドキュメント

DoCmd.TransferText メソッド

AcTextTransferType

サポートするコード ページ

概要

CSV と HTML で出力していますが、どちらも最後の引数にコードページを示す値で、UTF-8 を意味する 65001 をセットしています。そうすると、HTML では自動的に META 要素に UTF-8 が設定されて、ファイルは UTF8N になります。CSV もまた UTF8N で出力されます。

最初の引数で、エクスポートタイプを指定していますが、本来定数定義されているタイプライブラリを GUID で参照してそのまま使用しています。

GUID は、OLE-COM Object Viewer(Visual Studio 2010) で、Type Libraries ツリーより Microsoft Access 14.0 Object Library を開いて 取得しています。
<JOB>
<OBJECT id="Acc" progid="Access.Application" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<REFERENCE guid="4AFFC9A0-5F99-101B-AF4E-00AA003F0F07" />
<SCRIPT language="VBScript">
' **************************************
' スクリプトのあるディレクトリの取得
' **************************************
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

Acc.OpenCurrentDatabase( strCurPath & "\社員マスタ.accdb") 

Acc.docmd.TransferText acExportDelim, "", "社員マスタ", strCurPath & "\syain.csv", true, "", 65001
Acc.docmd.TransferText acExportHTML, "", "社員マスタ", strCurPath & "\syain.html", true, "", 65001

Acc.docmd.Closedatabase

' 終了確認
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>

ファイルのバスの後の True は、1 行目をフィールド名として使用すると言う意味です。。テキスト ファイルの 1 行目をデータとして処理する場合は、False (0) を使います。この引数を指定しないと、False (既定値) が使われます。


タグ:VBScript access
posted by lightbox at 2015-02-24 21:17 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2014年08月13日


VBScript : ネイティブ(CAPICOM.Utilities) Base64 エンコード

Stream オブジェクトと併用するのがミソです。この場合、Shift_JIS の文字列を Base64 に変換します。

Microsoft のドキュメント

Utilities Object (Windows)

関連する記事

VBScript : ネイティブ SHA1、MD5、SHA256 変換
Set CAPIUtil = CreateObject( "CAPICOM.Utilities" )
Set Stream = CreateObject("ADODB.Stream")
Set StreamBin = CreateObject("ADODB.Stream")

'******************************
' Base64 エンコード
'******************************
Stream.Open
Stream.Charset = "shift_jis"
' shift_jis で入力文字を書き込む
Stream.WriteText "日本語表示OK"
Stream.Position = 0

' バイナリで開く
StreamBin.Open
StreamBin.Type = 1

' テキストをバイナリに変換
Stream.CopyTo StreamBin
Stream.Close

' 読み込みの為にデータポインタを先頭にセット
StreamBin.Position = 0

' 変換
strBinaryString = CAPIUtil.ByteArrayToBinaryString( StreamBin.Read )
strBase64 = CAPIUtil.Base64Encode( strBinaryString )
' 長い文字列は仕様として、(\r\n を含めて 76) 改行されます
strBase64 = Replace(strBase64,vbCrLf,"")

Wscript.Echo strBase64



タグ:Base64 CAPICOM
posted by lightbox at 2014-08-13 23:32 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

VBScript で、スクリプト(Windows Script Component)をオブジェクトとして直接使う方法

guid を設定して、COM として登録する方法がありますが、スクリプトのパスを指定して実行する方法です

Windows Script Component

my_const.wsc
<component>
<public>
<method name="get_value"></method>
</public>
<script language="VBScript">
sub get_value(ByRef my_const)
	my_const = "2014/08/13"
end sub
</script>
</component>


test.vbs
Set my_script_obj = GetObject("script:C:\user\my_const.wsc")
data = 0
call my_script_obj.get_value( data )
WScript.Echo data


タグ:VBScript
posted by lightbox at 2014-08-13 02:04 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2014年03月13日


VBScript : バイナリファイルの更新( 1バイトの ByteArray なら、ADO.Stream で作成できます )



VBScript 内でバイナリファイルを更新するのは、ByteArray というデータ型で文字列を保持する必要があるのですが、VBScript 標準ではそのようなデータ型を作成する事ができません。

しかし、ADODB.Stream を使ってバイナリファイルからデータを Read メソッドで読み出すと、それは ByteArray になります。長い文字列として ByteArray を取得するにはもう少し応用が必要ですが、1バイト単位の ByteArray であれば、先に 256 種類のバイトを格納したファイルを用意しておけば、取得する事ができます。



このデータを使って、ビットマップファイルを更新するのであれば、色コードの表現は 1バイトづつなので、例えば 32 x 32 の24ビットマップを全て赤に設定しておいて、緑やその他の色に変更する事は容易になります。


※ 赤枠部分が色コードで、それが連続して、32 x 32 セット存在します
Set Fso = CreateObject( "Scripting.FileSystemObject" )
Set Stream = CreateObject("ADODB.Stream")
Set StreamTable = CreateObject("ADODB.Stream")

strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

strFullPath = Fso.GetAbsolutePathName( strCurPath & "\red.bmp" )

StreamTable.Open
StreamTable.Type = 1	' バイナリ
StreamTable.LoadFromFile strCurPath & "\byte_array.dat"

Stream.Open
Stream.Type = 1		' バイナリ

Stream.LoadFromFile strFullPath

For I = 1 to 32*32

	Stream.Position = 16*3+(I-1)*3+7	' Green 位置
	Stream.Write  GetByteArray(255)

	Stream.Position = 16*3+(I-1)*3+8	' Red 位置
	Stream.Write  GetByteArray(0)

Next

Stream.SaveToFile strCurPath & "\green.bmp", 2

Stream.Close
StreamTable.Close

Function GetByteArray( nData )

	StreamTable.Position = nData

	GetByteArray = StreamTable.Read(1)

End Function

strCurPath は、スクリプトが存在するフォルダになります。
※ GetByteArray は、1バイトの ByteArray データを取得します

CAPICOM をインストールすると、容易に ByteArray を扱えるようになります。

CAPICOM は、標準の Windows ではインストールされないと思いますが、Microsoft の何かの開発系ソフトウェアをインストールするとインストールされてしまっている可能性はあります。

CAPICOM には、Utilities object が存在し、以下のような便利なメソッドが揃っています。
※ Set CAPIUtil = CreateObject( "CAPICOM.Utilities" ) でオブジェクトを作成してメソッドを使用
MethodDescription
Base64Decode

Decodes a string from base64.

Base64Encode

Encodes a string as base64.

BinaryStringToByteArray

Converts a binary-packed string to an array of bytes.

BinaryToHex

Converts a binary-packed string to a hexadecimal string.

ByteArrayToBinaryString

Converts an array of bytes to a binary-packed string.

GetRandom

Generates a secure random number.

HexToBinary

Converts a hexadecimal string to a binary-packed string.

LocalTimeToUTCTime

Converts the computer's local time to Coordinated Universal Time.

UTCTimeToLocalTime

Converts Coordinated Universal Time to the computer's local time.

BinaryString は、VBscript で表現されている通常の文字列です。例えば、ChrB(0) 等のデータを含むバイナリデターであるという意味です


posted by lightbox at 2014-03-13 18:37 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2013年12月30日


VBScript : ini ファイルの値を取得する

cscript.exe ini.vbs "PATH" セクション名 エントリ名
で、値を echo します。バッチファイルを使うならば、同じディレクトリに ini.bat を作成して、
@echo off
cscript.exe //NOLOGO "%~dp0ini.vbs" "%1" %2 %3
とすると、パスの通ったディレクトリに両方置いて、"ini" というコマンドの出来上がりです エラーメッセージは、イベントビュアーの『アプリケーション』に記録されます
' ログ出力用
Set WshShell = WScript.CreateObject("WScript.Shell")

' 使用方法の表示
if Wscript.Arguments.Count = 0 then
	Wscript.Echo "Usage : cscript.exe ini.vbs ""PATH"" section entry"
	Wscript.Echo "例	 : cscript.exe ini.vbs ""c:\php\php.ini"" php error_reporting"
	Wscript.Quit
end if
' ファイルシステムアクセス用
Set Fs = CreateObject( "Scripting.FileSystemObject" )
' 引数の数をチェック( パス セクション エントリ )
if Wscript.Arguments.Count <> 3 then
	' 引数の数が誤っている場合は終了
	WshShell.LogEvent 1, "引数の数が誤っています"
	Wscript.Quit
end if
' ファイルを開く
on error resume next
Set InObj = Fs.OpenTextFile( Wscript.Arguments(0), 1 )
if Err.Number <> 0 then
	' ファイルアクセスエラーの場合は終了
	WshShell.LogEvent 1, Err.Description & ":" & Wscript.Arguments(0)
	Wscript.Quit
end if
on error goto 0

' 検索処理用のフラグ
search = false
' 読込みループ
Do While not InObj.AtEndOfStream
	' 行単位の読込み
	Buffer = InObj.ReadLine
	' 空の行は無視する
	if Trim(Buffer) <> "" then
		' 対象セクションを発見した場合
		if Ucase(Trim(Buffer)) = "[" & Ucase(Wscript.Arguments(1)) & "]" then
			search = true
		else
			' 一度発見した場合は同じセクションは無いのでこちらへ
			' 発見してない場合もこちらに来ますが、search が true なら発見済み
			if search then
				' 次のセクションを発見した場合は、該当するエントリが無い事を示す
				if Left(Trim(Buffer),1) = "[" then
					' 処理を終了する為、ループを終了する
					WshShell.LogEvent 1, "指定されたエントリを発見できませんでした:" & Wscript.Arguments(2)
					Exit Do
				end if
				' 先頭行がセミコロンの場合は、コメントとみなします
				RealLine = Split(Buffer,";")
				' セミコロンがあった場合、RealLine(0) は空です
				Entry = Split(RealLine(0),"=")
				' 通常行の場合、= が見つかればエントリです
				if ( Ubound(Entry) = 1 ) then
					' エントリが検索対象かどうかをチェック
					if Ucase(Trim(Entry(0))) = Ucase(Wscript.Arguments(2)) then
						' 一致した場合のみ値を表示
						Wscript.Echo(Trim(Entry(1)))
						' ファイルを閉じて終了する
						InObj.Close
						Wscript.Quit
					End if
				end if
			end if
		end if
	end if
Loop
' ここは、検索対象が発見できなかった場合の終了です
InObj.Close
if search then
	WshShell.LogEvent 1, "指定されたエントリを発見できませんでした:" & Wscript.Arguments(2)
else
	WshShell.LogEvent 1, "指定されたセクションを発見できませんでした:" & Wscript.Arguments(1)
end if
Wscript.Echo



タグ:VBScript
posted by lightbox at 2013-12-30 05:16 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2011年08月12日


VBS : My Documents フォルダのような、特殊フォルダのサイズを取得する

以下のリンク先は英文ですが、Shell オブジェクトで利用する特殊フォルダのコード一覧です。
ShellSpecialFolderConstants Enumeration (Windows)

通常のファイルでは、Shell オブジェクトは必要ありません。FileSystemObject
に直接パスを渡してサイズを取得する事ができます。
Const MY_DOCUMENTS = &H5
 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objShell = CreateObject("Shell.Application") 
 
Set objFolder = objShell.Namespace(MY_DOCUMENTS) 
Set objFolderItem = objFolder.Self 
strPath = objFolderItem.Path 
 
Set objFolder = objFSO.GetFolder(strPath) 
Wscript.Echo objFolder.Size 
Hey, Scripting Guy!
My Documents フォルダのサイズを判断する方法はありますか


posted by lightbox at 2011-08-12 09:23 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2010年05月29日


VBScript : ネイティブ SHA1、MD5、SHA256 変換

Microsoft ドキュメント

HashedData Object (Windows)

関連する記事

VBScript : ネイティブ Base64 エンコード
Set CAPIUtil = CreateObject( "CAPICOM.Utilities" )
Set HashedData = CreateObject( "CAPICOM.HashedData" )
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

'***********************************************************
' データ準備4
'***********************************************************
Stream.Open
Stream.Charset = "shift_jis"
' shift_jis で入力文字を書き込む
Stream.WriteText "日本語表示OK"
Stream.Position = 0

' バイナリで開く
StreamBin.Open
StreamBin.Type = 1

' テキストをバイナリに変換
Stream.CopyTo StreamBin
Stream.Close

' 読み込みの為にデータポインタを先頭にセット
StreamBin.Position = 0

strBinaryString = CAPIUtil.ByteArrayToBinaryString( StreamBin.Read )

'***********************************************************
' SHA1 と MD5 と SHA256
'***********************************************************
' SHA1
HashedData.Algorithm = 0
HashedData.Hash(strBinaryString)

MsgBox(LCase(HashedData.Value))

' MD5
HashedData.Algorithm = 3
HashedData.Hash(strBinaryString)

MsgBox(LCase(HashedData.Value))

' SHA256
HashedData.Algorithm = 4
HashedData.Hash(strBinaryString)

MsgBox(LCase(HashedData.Value))




posted by lightbox at 2010-05-29 21:12 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2009年05月29日


VBScript : 複数テキストファイルの charset(キャラクタセット) 一括変換 / ADODB.Stream

ADODB.Stream を使用すると、テキストファイルのキャラクタセットををメモリ内で変換する事ができます

※ 変換元と変換後のキャラクタセットを指定する必要があります
※ ここでの対象ディレクトリはカレントにある "res" ディレクトリです
Set Fso = CreateObject( "Scripting.FileSystemObject" )
Set Stream = CreateObject("ADODB.Stream")
Set Stream2 = CreateObject("ADODB.Stream")

Set objFolder = Fso.GetFolder( "res" )
Set objFiles = objFolder.Files

For each objFile in objFiles
	' フルパス
	strFullPath = Fso.GetAbsolutePathName( "res\" & objFile.Name )

	Stream.Open
	Stream.Type = 2		' StreamTypeEnum の adTypeText
	Stream.Charset = "utf-8"
	Stream.LoadFromFile strFullPath
	Stream2.Open
	Stream2.Charset = "shift_jis"
	Stream.CopyTo Stream2
	Stream2.SaveToFile strFullPath, 2
	Stream2.Close
	Stream.Close

Next





タグ:VBScript
posted by lightbox at 2009-05-29 13:09 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します


Windows
container 終わり

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

Android SDK ポケットリファレンス
改訂版 Webデザイナーのための jQuery入門
今すぐ使えるかんたん ホームページ HTML&CSS入門
CSS ドロップシャドウの参考デモ
Google Hosted Libraries
cdnjs
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり