Archive for 2011年4月

災害ボランティア検索APIをVBScriptから呼び出す

2011/04/27

災害ボランティア検索APIをVBScriptから呼び出してみます(エラー処理等手抜き)。
※ 要アプリケーションID

Option Explicit

Dim oXML
Dim oNode
Dim url
Dim status
Dim q '検索クエリー
Const AppID = "(アプリケーションID)" 'アプリケーションID

q = InputBox("検索文字列を入力してください。")
If IsEmpty(q) Then WScript.Quit
If q = "" Then WScript.Quit

url = "http://shinsai.yahooapis.jp/v1/volunteers?appid=" & AppID & "&query=" & EncodeURL(q)
Set oXML = GetXMLDocument(url)
If oXML Is Nothing Then WScript.Quit

WScript.Echo "■災害ボランティア情報(検索キーワード:" & q & ")"
WScript.Echo "--------------------"
On Error Resume Next
For Each oNode In oXML.SelectNodes("/Messages/Message")
  status = oNode.SelectSingleNode("Status").Text
  Select Case CInt(status)
    Case 0
      status = "募集終了"
    Case 1
      status = "現在募集中"
    Case Else
      status = "募集状況不明"
  End Select
  WScript.Echo "募集メッセージのタイトル:" &  oNode.SelectSingleNode("Title").Text & "(" & status & ")"
  WScript.Echo "情報が最後に変更された時間:" &  oNode.SelectSingleNode("UpdateTime").Text
  WScript.Echo "場所:" &  oNode.SelectSingleNode("Address").Text
  WScript.Echo "組織名:" &  oNode.SelectSingleNode("Organization").Text
  WScript.Echo "募集メッセージ:"
  WScript.Echo oNode.SelectSingleNode("Body").Text
  WScript.Echo "--------------------"
Next
If Err.Number <> 0 Then
  WScript.Echo "エラーが発生しました。"
  WScript.Echo "内容:" & Err.Description
  Err.Clear
End If
On Error GoTo 0
Set oXML = Nothing

Public Function GetXMLDocument(ByVal url)
'XML取得
  Dim oXML
  
  On Error Resume Next
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    Set oXML = .responseXML
  End With
  If Err.Number <> 0 Then
    Set oXML = Nothing
    Err.Clear
  End If
  On Error GoTo 0
  Set GetXMLDocument = oXML
End Function

Public Function EncodeURL(ByVal sWord)
'URLエンコード
  Dim d
  Dim elm
  
  sWord = Replace(sWord, "\", "\\")
  sWord = Replace(sWord, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
  EncodeURL = elm.innerText
End Function

結果はリダイレクトで受け取るのが良さそうです。

広告

Live HTTP HeadersをFirefox 4で使用する

2011/04/25

2011年5月6日追記:
mozdev.org – livehttpheaders: installationでFirefox 4に対応したLiveHTTPHeadersのversion 0.17が公開されました。
今後は下記のようにversion 0.16のファイルを編集しなくてもFirefox 4でLiveHTTPHeadersを利用することができます。

 

Live HTTP HeadersはFirefox 4に対応していませんが(2011年4月25日時点)、Live HTTP Headers 0.16のコメント部分に無理矢理対応させる方法が書いてあったので、メモ書き程度に一応書いておきます。

1. mozdev.org – livehttpheaders: installationから「livehttpheaders-0.16.xpi」ファイルをダウンロードします。
2. livehttpheaders-0.16.xpiファイルをZip解凍し、出力された「install.rdf」ファイルをテキストエディタで開きます。
3.<em:maxVersion>3.6.*</em:maxVersion>」部分を「<em:maxVersion>4.0.*</em:maxVersion>」に変更し、上書き保存します。
4. 2.で解凍したファイルを再度圧縮し、拡張子を「xpi」に変更します。
5. 4.のxpiファイルをFirefoxにドラッグ&ドロップします。
6. 画面の指示に従ってインストールします。

Firefox 4ではWebコンソールが使えるのでLive HTTP Headersを使わなくても大丈夫なのですが、やはり使い慣れたものの方が使いやすいです。

MP3の情報を取得するVBScript

2011/04/24

※ Windows 7にて実行。
MP3ファイルからタイトルやアーティスト名などを取得するには?[C#、VB] 参照

Option Explicit

Dim itm

With CreateObject("Shell.Application").Namespace("C:\Users\Public\Music\Sample Music")
  For Each itm In .Items
    If InStr(LCase(itm.Type), "mp3") Then
      WScript.Echo itm.Name & " , ファイルサイズ:" & .GetDetailsOf(itm, 1)
      WScript.Echo itm.Name & " , ファイルの種類:" & .GetDetailsOf(itm, 2)
      WScript.Echo itm.Name & " , 更新日時:" & .GetDetailsOf(itm, 3)
      WScript.Echo itm.Name & " , 作成日時:" & .GetDetailsOf(itm, 4)
      WScript.Echo itm.Name & " , アクセス日時:" & .GetDetailsOf(itm, 5)
      WScript.Echo itm.Name & " , 属性:" & .GetDetailsOf(itm, 6)
      WScript.Echo itm.Name & " , 所有者:" & .GetDetailsOf(itm, 10)
      WScript.Echo itm.Name & " , 参加アーティスト:" & .GetDetailsOf(itm, 13)
      WScript.Echo itm.Name & " , アルバム:" & .GetDetailsOf(itm, 14)
      WScript.Echo itm.Name & " , 年:" & .GetDetailsOf(itm, 15)
      WScript.Echo itm.Name & " , ジャンル:" & .GetDetailsOf(itm, 16)
      WScript.Echo itm.Name & " , 指揮者:" & .GetDetailsOf(itm, 17)
      WScript.Echo itm.Name & " , 評価:" & .GetDetailsOf(itm, 19)
      WScript.Echo itm.Name & " , 参加アーティスト:" & .GetDetailsOf(itm, 20)
      WScript.Echo itm.Name & " , タイトル:" & .GetDetailsOf(itm, 21)
      WScript.Echo itm.Name & " , コメント:" & .GetDetailsOf(itm, 24)
      WScript.Echo itm.Name & " , トラック番号:" & .GetDetailsOf(itm, 26)
      WScript.Echo itm.Name & " , 長さ:" & .GetDetailsOf(itm, 27)
      WScript.Echo itm.Name & " , ビット レート:" & .GetDetailsOf(itm, 28)
      WScript.Echo itm.Name & " , コンピューター:" & .GetDetailsOf(itm, 53)
      WScript.Echo itm.Name & " , 名前:" & .GetDetailsOf(itm, 155)
      WScript.Echo itm.Name & " , フォルダーのパス:" & .GetDetailsOf(itm, 177)
      WScript.Echo itm.Name & " , 項目の種類:" & .GetDetailsOf(itm, 182)
      WScript.Echo itm.Name & " , エンコード方式:" & .GetDetailsOf(itm, 193)
      WScript.Echo itm.Name & " , 発行元:" & .GetDetailsOf(itm, 195)
      WScript.Echo itm.Name & " , サブタイトル:" & .GetDetailsOf(itm, 196)
      WScript.Echo itm.Name & " , アルバムのアーティスト:" & .GetDetailsOf(itm, 217)
      WScript.Echo itm.Name & " , ビート数/分:" & .GetDetailsOf(itm, 219)
      WScript.Echo itm.Name & " , 作曲者:" & .GetDetailsOf(itm, 220)
      WScript.Echo itm.Name & " , イニシャル キー:" & .GetDetailsOf(itm, 221)
      WScript.Echo itm.Name & " , コンパイルの一部:" & .GetDetailsOf(itm, 222)
      WScript.Echo itm.Name & " , 雰囲気:" & .GetDetailsOf(itm, 223)
      WScript.Echo itm.Name & " , セットのパート:" & .GetDetailsOf(itm, 224)
      WScript.Echo itm.Name & " , サブタイトル:" & .GetDetailsOf(itm, 254)
      WScript.Echo itm.Name & " , 共有ユーザー:" & .GetDetailsOf(itm, 268)
    End If
  Next
End With

ウィンドウの切り替えを実行するVBScript

2011/04/24

※ Vista以降限定

CreateObject("Shell.Application").WindowSwitcher()

Excel 97でCALL関数をワークシート上から使ってみました。

2011/04/17

VBScriptからWindows API関数を呼び出す」でExcelのCALL関数を紹介しましたが、Excel 97でワークシート上から使ってみたのでスクリーンショットを掲載。

この関数がSUM関数やVLOOKUP関数などの関数と同様にワークシート上からも普通に使えるのはやはり危険ですね。
(2000以降ではワークシート上からの呼び出しができなくなっています。)

VBScriptからWindows API関数を呼び出す

2011/04/17

VBSからAPI関数を呼び出す方法として、別途作成したDLL経由で呼び出す方法や”SFC mini“、”DynaCall“といったツールを使う方法がありますが、わりとよく使われるのが『Excel経由でCALL関数を使って呼び出す』方法です。

Dim h

CreateObject("WScript.Shell").Run "notepad", 1, False
With CreateObject("Excel.Application")
  h = .ExecuteExcel4Macro("CALL(""user32"", ""FindWindowA"", ""JCJ"", ""Notepad"", 0)")
  If h = 0 Then WScript.Quit
  Call .ExecuteExcel4Macro("CALL(""user32"", ""SendMessageA"", ""JJJJJ"", " & h & ", 273, 65, 0)")
End With

上記コードを見るとExecuteExcel4MacroメソッドでExcel4.0マクロ関数を実行しているようですが、ここで使われているのが実は「CALL」関数です。この関数の引数でAPI関数名やDLL名を指定しているわけです。

CALL(モジュール名, プロシージャ名, タイプ, [引数 1], …, [引数 n])

CALL 関数」より

第一引数でモジュール名、第二引数で関数名、これはすぐ分かると思いますが、問題なのが第三引数。上記コードを見ると「JJJJJ」となっていて、これが一体何を表しているのかよく分からない人も多いだろうと思います。
そこでMicrosoftの説明ページを見てみると、下記のような記述があります。

“タイプ” の先頭の文字では、戻り値のデータ型を指定します。残りの文字では、すべての引数のデータ型を指定します。たとえば、戻り値が浮動小数点数、引数が整数と浮動小数点数である DLL 関数は、”タイプ” 引数として “BIB” を取ります。

この「JJJJJ」というのは戻り値と引数のデータ型を文字列で表しているわけです。

そこで、改めて上記コードが一体どのような処理を行っているのかというと、

1. メモ帳を起動します。
2. FindWindowでメモ帳のウィンドウハンドルを取得します。
3. 2.で取得したハンドルを元にウィンドウに対してSendMessageでWM_COMMAND(&H111(273))、wParam:&H41(65)を送り、メモ帳のバージョン情報を表示します。

といった処理を行っているわけです。

上記のようなVBSからAPI関数を呼び出す処理は、ウィンドウズスクリプトプログラマさんのブログ「Windows Script Programming」にて多数紹介されていますので、興味がある方は参考にされてはいかがでしょうか。

Excel 2010でページ設定(PageSetup)の動作を高速化する

2011/04/16

1年近く前につぶやいた話題ですが、今になっても取り扱っているサイトが少ないので今回記事を書いてみます。

Excel VBAでのページ設定(PageSetup)の動作が遅いことはよく知られたことで、これまでは高速化のためにExcel 4.0(XLM)マクロのPAGE.SETUP()が多くの場面で使われてきました。

Excel 2010では新たに「Application.PrintCommunication」プロパティが追加され、PageSetupプロパティを設定するコードの実行を高速化することができるようになりました。

実際にテストしたコードと結果は下記の通りです(テストしたブックは255シートで、1シートずつループで処理しています)。

Public Sub Test01()
'PrintCommunicationプロパティ無し
  Dim sht As Excel.Worksheet
  Dim t1 As Single, t2 As Single
  
  t1 = Timer
  For Each sht In ActiveWorkbook.Worksheets
    With sht.PageSetup
      .LeftMargin = Application.InchesToPoints(0.25)
      .RightMargin = Application.InchesToPoints(0.25)
      .TopMargin = Application.InchesToPoints(0.75)
      .BottomMargin = Application.InchesToPoints(0.75)
      .Orientation = xlLandscape
      .PaperSize = xlPaperLetter
      .FitToPagesWide = 1
      .FitToPagesTall = 1
    End With
  Next
  t2 = Timer
  MsgBox "Test01処理時間:" & t2 - t1 & "秒"
  Debug.Print t2 - t1
End Sub

Public Sub Test02()
'PrintCommunicationプロパティ有り
  Dim sht As Excel.Worksheet
  Dim t1 As Single, t2 As Single
  
  t1 = Timer
  Application.PrintCommunication = False
  For Each sht In ActiveWorkbook.Worksheets
    With sht.PageSetup
      .LeftMargin = Application.InchesToPoints(0.25)
      .RightMargin = Application.InchesToPoints(0.25)
      .TopMargin = Application.InchesToPoints(0.75)
      .BottomMargin = Application.InchesToPoints(0.75)
      .Orientation = xlLandscape
      .PaperSize = xlPaperLetter
      .FitToPagesWide = 1
      .FitToPagesTall = 1
    End With
  Next
  Application.PrintCommunication = True
  t2 = Timer
  MsgBox "Test02処理時間:" & t2 - t1 & "秒"
  Debug.Print t2 - t1
End Sub

上記結果を見ると確かにPrintCommunicationプロパティを設定した方が早く処理が終わっています。
下記Microsoftのページを見ると、Excel 4.0 マクロから新たに追加された機能への移行が推奨されているようです。

Excel 4.0 マクロを操作する
http://office.microsoft.com/ja-jp/excel-help/HA010336614.aspx
Migrating Excel 4 Macros to VBA
http://blogs.office.com/b/microsoft-excel/archive/2010/02/16/migrating-excel-4-macros-to-vba.aspx

Excel 2010を使用していて、PageSetupの遅さにお悩みの方は一度試してみてはいかがでしょうか?

Word 2010に一太郎コンバーターを導入する

2011/04/14

Word 2010 で廃止、変更される機能」にあるように、Word 2010では一太郎コンバーターが無くなり一太郎ファイルが開けなくなりました(今後コンバーターが提供されるようになる可能性はあります)。

そのかわりとしてよく用いられるのが一太郎ビューアですが、今回はWord 2010に無理矢理一太郎コンバーターを導入する方法を紹介します。

※ 下記に紹介する方法はWord 2007の一太郎コンバーターをWord 2010に導入する方法で、私の方では使用していないOffice 2007のディスクから一太郎コンバーターのみを抜き出して動作を確認しましたが、コンバーターのライセンスについては未確認です。もしかしたらライセンス違反になる可能性もありますので、取り扱いには十分ご注意ください。ライセンス違反であることが確認された場合には当記事も公開を停止します。

※ 下記の方法はWindows 7 Ultimate(64ビット版) + Office 2010(32ビット版)、Windows 7 Ultimate(32ビット版) + Office 2010(32ビット版)上で動作確認を行いました。Office 2010(64ビット版)上ではエラーが発生してコンバータの動作を確認することができませんでした。
 
[手順]
1. Office 2007のディスク内の「Office.ja-jp」フォルダにある「OfficeLR.cab」ファイルから下記のファイルのみを展開します。
(展開方法はWindows 7であれば右クリックメニュー「プログラムから開く」の「エクスプローラー」からファイルを取り出すことができます。また、cab形式に対応した解凍ソフトを用いることでもファイルを取り出すことができます。)

JWSPCNV.DLL_0001_1041
JXW7.DLL_0001_1041
JXW8.DLL_0001_1041
RTF_.DLL_0001_1041
TARO7.CNV_0001_1041
TARO8.CNV_0001_1041



2. 1.で取り出したファイルの名前をそれぞれ下記のように変更します(ファイル名の「_0001_1041」部分を削除します)。

JWSPCNV.DLL
JXW7.DLL
JXW8.DLL
RTF_.DLL
TARO7.CNV
TARO8.CNV

3. ファイルのプロパティから「読み取り専用」を解除します。

4. 下記テキストコンバーターフォルダにファイルを移動します。

32ビット版OS:C:\Program Files\Common Files\microsoft shared\TextConv
64ビット版OS:C:\program files (x86)\common files\microsoft shared\textconv

5.ファイル名を指定して実行」から下記コマンドを実行し、レジストリエディタを起動します。

32ビット版OS:regedit
64ビット版OS:%systemroot%\syswow64\regedit

※ 64ビット環境でのレジストリ編集に関しては「64 ビット バージョンの Windows でシステム レジストリを表示する方法」参照。

6. 下記のようにキーを設定します(キーやデータが存在しない場合は新規作成)。

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro7
[データ:値]
Extensions(タイプ:文字列値):JFW JVW
Name(タイプ:文字列値):一太郎 7
Path(タイプ:文字列値):(手順 4. のテキストコンバーターフォルダのパス)\TARO7.CNV

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro7\NoDialogs
[データ:値]
(既定):(空白)

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro8
[データ:値]
Extensions(タイプ:文字列値):JTD JTT
Name(タイプ:文字列値):一太郎 8-13/2004-2006
Path(タイプ:文字列値):(手順 4. のテキストコンバーターフォルダのパス)\TARO8.CNV

[キー位置]
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Text Converters\Import\Ichitaro8\NoDialogs
[データ:値]
(既定):(空白)




以上で作業は終了です。
以降Wordで一太郎ファイルが開けるようになります。


ドラッグされたマネージドDLLをRegAsmで登録するスクリプト

2011/04/07

supermabさんのブログの記事「Excel から使うマネージDLL を作る。」、ここまで丁寧に解説されたサイトは少ないので非常に参考になります。
ただ、記事中にも書かれていますがDLLの登録・登録解除がどうしても手間になってしまいます。

XPであれば特に大きな問題は無いのですが、Vista以降UACが絡んでくる都合上、一工夫する必要がありそうです。
では具体的にどうするか?パッと思いつくのは「runas」付きでShellExecuteメソッドを実行する方法。
早速試してみました。

'*********************************************************
' ドラッグされたマネージドDLLをRegAsmで登録するスクリプト
' 
' 2011/04/05 kinuasa
'*********************************************************

Option Explicit

Dim Args
Dim FSO
Dim f
Dim DllFilePath
Dim WindowsFolderPath
Dim FrameworkFolderPath
Dim SubFrameworkFolderPath
Dim RegAsmFilePath
Dim ArgStr
Const Opt = " /tlb /codebase" 'RegAsmに渡すオプション
Const MsgTitle = "RegAsm実行"

RegAsmFilePath = "" '初期化

Set Args = WScript.Arguments
If Args.Count < 1 Then
  MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Select Case LCase(FSO.GetExtensionName(Args(0)))
  Case "dll"
    DllFilePath = Args(0)
  Case Else
    MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
    WScript.Quit
End Select
Set Args = Nothing

'.NET Frameworkフォルダのパス取得
WindowsFolderPath = FSO.GetSpecialFolder(0).Path
If Right(WindowsFolderPath, 1) <> "\" Then WindowsFolderPath = WindowsFolderPath & "\"
FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework\"
If FSO.FolderExists(FrameworkFolderPath) <> True Then
  MsgBox ".NET Frameworkフォルダが見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If
'RegAsm.exeのパス取得
With CreateObject("ADODB.Recordset")
  .Fields.Append "Path", 200, 255
  .Open
  For Each f In FSO.GetFolder(FrameworkFolderPath).SubFolders
    .AddNew
    .Fields("Path").Value = f.Path
    .Update
  Next
  .Sort = "Path DESC" 'Framework各バージョンフォルダ名を降順ソート
  .MoveFirst
  Do Until .EOF
    SubFrameworkFolderPath = .Fields(0)
    If Right(SubFrameworkFolderPath, 1) <> "\" Then SubFrameworkFolderPath = SubFrameworkFolderPath & "\"
    If FSO.FileExists(SubFrameworkFolderPath & "RegAsm.exe") Then
      If MsgBox("[" & SubFrameworkFolderPath & "RegAsm.exe]で登録しますか?", vbYesNo, MsgTitle) = vbYes Then
        RegAsmFilePath = SubFrameworkFolderPath & "RegAsm.exe"
        Exit Do
      End If
    End If
    .MoveNext
  Loop
  .Close
End With
Set FSO = Nothing
If Len(RegAsmFilePath) < 1 Then
  MsgBox "[RegAsm.exe]が見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If

ArgStr = """" & DllFilePath & """" & Opt
CreateObject("Shell.Application").ShellExecute RegAsmFilePath, ArgStr, "", "runas" 'runas付きで実行
'*************************************************************
' ドラッグされたマネージドDLLをRegAsmで登録解除するスクリプト
' 
' 2011/04/05 kinuasa
'*************************************************************

Option Explicit

Dim Args
Dim FSO
Dim f
Dim DllFilePath
Dim WindowsFolderPath
Dim FrameworkFolderPath
Dim SubFrameworkFolderPath
Dim RegAsmFilePath
Dim ArgStr
Const Opt = " /tlb /u" 'RegAsmに渡すオプション
Const MsgTitle = "RegAsm実行"

RegAsmFilePath = "" '初期化

Set Args = WScript.Arguments
If Args.Count < 1 Then
  MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Select Case LCase(FSO.GetExtensionName(Args(0)))
  Case "dll"
    DllFilePath = Args(0)
  Case Else
    MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
    WScript.Quit
End Select
Set Args = Nothing

'.NET Frameworkフォルダのパス取得
WindowsFolderPath = FSO.GetSpecialFolder(0).Path
If Right(WindowsFolderPath, 1) <> "\" Then WindowsFolderPath = WindowsFolderPath & "\"
FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework\"
If FSO.FolderExists(FrameworkFolderPath) <> True Then
  MsgBox ".NET Frameworkフォルダが見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If
'RegAsm.exeのパス取得
With CreateObject("ADODB.Recordset")
  .Fields.Append "Path", 200, 255
  .Open
  For Each f In FSO.GetFolder(FrameworkFolderPath).SubFolders
    .AddNew
    .Fields("Path").Value = f.Path
    .Update
  Next
  .Sort = "Path DESC" 'Framework各バージョンフォルダ名を降順ソート
  .MoveFirst
  Do Until .EOF
    SubFrameworkFolderPath = .Fields(0)
    If Right(SubFrameworkFolderPath, 1) <> "\" Then SubFrameworkFolderPath = SubFrameworkFolderPath & "\"
    If FSO.FileExists(SubFrameworkFolderPath & "RegAsm.exe") Then
      If MsgBox("[" & SubFrameworkFolderPath & "RegAsm.exe]で登録解除しますか?", vbYesNo, MsgTitle) = vbYes Then
        RegAsmFilePath = SubFrameworkFolderPath & "RegAsm.exe"
        Exit Do
      End If
    End If
    .MoveNext
  Loop
  .Close
End With
Set FSO = Nothing
If Len(RegAsmFilePath) < 1 Then
  MsgBox "[RegAsm.exe]が見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If

ArgStr = """" & DllFilePath & """" & Opt
CreateObject("Shell.Application").ShellExecute RegAsmFilePath, ArgStr, "", "runas" 'runas付きで実行

上記スクリプトにDLLファイルをドラッグ&ドロップ。
tlbファイルを出力されて、VBAからでも使うことが出来ました。
なかなか上手くいっていそうです。

上記スクリプトをZip形式で圧縮したのがコチラ

インストールされているウィルス対策ソフトの情報を列挙するVBScript

2011/04/06

使い道は不明です。

Option Explicit

Dim colItems
Dim oItem

On Error Resume Next
Set colItems = CreateObject("WbemScripting.SWbemLocator") _
              .ConnectServer(".", "root\SecurityCenter2") _
              .ExecQuery("Select * from AntiVirusProduct")
For Each oItem In colItems
  WScript.Echo "displayName:" & oItem.displayName
  WScript.Echo "instanceGuid:" & oItem.instanceGuid
  WScript.Echo "pathToSignedProductExe:" & oItem.pathToSignedProductExe
  WScript.Echo "pathToSignedReportingExe:" & oItem.pathToSignedReportingExe
  WScript.Echo "productState:" & oItem.productState
Next
Set colItems = Nothing

If Err.Number <> 0 Then
  Set colItems = CreateObject("WbemScripting.SWbemLocator") _
                .ConnectServer(".", "root\SecurityCenter") _
                .ExecQuery("Select * from AntiVirusProduct")
  For Each oItem In colItems
    WScript.Echo "companyName:" & oItem.companyName
    WScript.Echo "displayName:" & oItem.displayName
    WScript.Echo "enableOnAccessUIMd5Hash:" & oItem.enableOnAccessUIMd5Hash
    WScript.Echo "enableOnAccessUIParameters:" & oItem.enableOnAccessUIParameters
    WScript.Echo "instanceGuid:" & oItem.instanceGuid
    WScript.Echo "onAccessScanningEnabled:" & oItem.onAccessScanningEnabled
    WScript.Echo "pathToEnableOnAccessUI:" & oItem.pathToEnableOnAccessUI
    WScript.Echo "pathToUpdateUI:" & oItem.pathToUpdateUI
    WScript.Echo "productUptoDate:" & oItem.productUptoDate
    WScript.Echo "updateUIMd5Hash:" & oItem.updateUIMd5Hash
    WScript.Echo "updateUIParameters:" & oItem.updateUIParameters
    WScript.Echo "versionNumber:" & oItem.versionNumber
  Next
  Set colItems = Nothing
  Err.Clear
End If
On Error GoTo 0