Visual Basic for Applications を VBScript に置き換える方法

outlooklab スクリプト、Outlook VBA マクロ

コメントにて以下のようなご要望をいただきました。

Outlook2010のVBAをVBSで起動させたいと思っているのですが、どのようなVBSを作成すればよいのでしょうか？
またよろしければ、VBAをVBSに、VBSをVBAに変換できるような詳しいページ等を作っていただけたら幸いです。

Visual Basic for Applications (VBA) と VBScript (VBS) は、どちらも基本的に Visual Basic の文法を踏襲しており、Visual Basic のステートメントや関数が使用可能です。
しかし、VBA のオブジェクトや関数、ステートメントの中には VBScript で使えないものがいくつかあります。

その代表的なものは以下の通りです (完全なリストについては「Visual Basic for Applications Features Not In VBScript」を参照)。

  • Collection オブジェクト
  • On Error Goto などのエラー制御
  • Cvar、CVDate、Str、Val、StrConv などのデータ変換
  • Debug.Print などのデバッグ用ステートメント
  • Declare による DLL の関数定義
  • Open、Print、Input、Write、Get、Put などのファイル操作
  • Like 演算子
  • イベント処理

また、Outlook の VBA では最初から定義されて使えるオブジェクトや定数が使えなくなっていますので、それらを適切に定義する必要があります。
さらに、VBScript では変数の型宣言ができないため、変数同士の比較で予期しない型での比較が行われ、VBA と動作が変わってしまうことがあります。
その場合には、CInt や CDbl、CDate などによる明示的な型変換を行います。

以下では、VBA マクロを VBScript に変換する手順を説明します。

VBA を VBScript に置き換える手順

  1. 使用するマクロをテキスト ファイルにコピーする。
  2. ファイルの先頭に以下の記述を追加する。
    Dim Application
    Set Application = CreateObject("Outlook.Application")
  3. スクリプトで最初に実行したいマクロを呼び出す記述をグローバル変数の定義の後に追加する。
  4. マクロで使用している定数を定義する。
  5. ActiveExplorer や ActiveInspector、Session などについて、Application. を省略して使用していた場合は、すべて Application. を追加する。
  6. 変数宣言で As xxx とあるものについては、As 以降を削除する。
  7. On Error Goto xxx というようなエラー制御は、On Error Resume Next と If Err.Number <> ０ Then による制御に置き換える。
  8. Cvar や CVDate などの VBScript で使用できない関数は、その関数の代わりになるような関数を作る。
  9. Declare による DLL の関数定義は削除し、その代わりになるような機能を実現する ActiveX コントロールがないか探す。
  10. Open、Print などのファイル操作は Scripting.FileSystemObject に置き換える。
  11. Like 演算子は Instr 関数で代用可能であれば Instr 関数に置き換え、複雑な条件は RegExp オブジェクトでのマッチングに置き換える。
  12. 必要に応じて、CInt や CDbl、CDate で明示的に型変換を行う。

置き換えサンプル

上記を踏まえて VBA を VBS に置き換えるサンプルは以下の通りです。このマクロは指定された範囲で件名に meeting が含まれる予定を CSV にエクスポートし、印刷も実行するというものです。

VBA バージョン

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                (ByVal hwnd As Long, ByVal lpszOp As String, _
                 ByVal lpszFile As String, ByVal lpszParams As String, _
                 ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                 As Long
'
Public Sub ExportAndPrintCalendar()
    Const CSV_FILE_NAME = "c:\temp\calendar.csv"
    Dim fldCalendar As Folder
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim colAppts As Items
    Dim objAppt As AppointmentItem
    Dim strLine As String
    Set fldCalendar = Session.GetDefaultFolder(olFolderCalendar)
    '
    dtStart = InputBox("開始日")
    dtEnd = InputBox("終了日")
    dtEnd = DateAdd("d", 1, dtEnd)
    '
    Open CSV_FILE_NAME For Output As #1
    Print #1, """件名"",""場所"",""開始日"",""開始時刻"",""終了日"",""終了時刻"""
    Set colAppts = fldCalendar.Items
    colAppts.Sort "[Start]"
    colAppts.IncludeRecurrences = True
    For Each objAppt In colAppts
        If objAppt.Subject Like "*meeting*" And _
           objAppt.End >= dtStart And objAppt.Start <= dtEnd Then
            strLine = """" & objAppt.Subject & _
                """,""" & objAppt.Location & _
                """,""" & Format(objAppt.Start, "yyyy/mm/dd") & _
                """,""" & Format(objAppt.Start, "HH:MM") & _
                """,""" & Format(objAppt.End, "yyyy/mm/dd") & _
                """,""" & Format(objAppt.End, "HH:MM") & _
                """"
            Print #1, strLine
        End If
        If objAppt.Start >= dtEnd Then
            Exit For
        End If
    Next
    Close #1
    '
    ShellExecute 0, "print", CSV_FILE_NAME, 0, "c:\temp", 0
End Sub

これを VBScript にすると、以下のようになります。

VBScript バージョン

' 定数を定義 *4
olFolderCalendar = 9
' ファイルの先頭に以下の記述を追加 * 2
Dim Application
Set Application = CreateObject("Outlook.Application")
' スクリプトで最初に実行したいマクロを呼び出す記述をグローバル変数の定義の後に追加 *3
ExportAndPrintCalendar
'
Public Sub ExportAndPrintCalendar()
    Const CSV_FILE_NAME = "c:\temp\calendar.csv"
    Dim fldCalendar 'As Folder
    Dim dtStart 'As Date
    Dim dtEnd 'As Date
    Dim colAppts 'As Items
    Dim objAppt 'As AppointmentItem
    Dim strLine 'As String
    Dim objFSO 'As FileSystemObject
    Dim stmCsvFile 'As TextStream
    ' Application. を追加 *5
    Set fldCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    '
    dtStart = InputBox("開始日")
    dtEnd = InputBox("終了日")
    dtEnd = DateAdd("d", 1, dtEnd)
    ' Open を FileSystemObject の CreateTextFile に置き換え *10
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set stmCsvFile = objFSO.CreateTextFile(CSV_FILE_NAME)
    ' Print を TextStream の WriteLine に置き換え *10
    stmCsvFile.WriteLine """件名"",""場所"",""開始日"",""開始時刻"",""終了日"",""終了時刻"""
    Set colAppts = fldCalendar.Items
    colAppts.Sort "[Start]"
    colAppts.IncludeRecurrences = True
    For Each objAppt In colAppts
        ' Like を Instr に置き換え *11
        ' CDate を使って日付型での比較を明示 *12
        If Instr(objAppt.Subject,"meeting") > 0 And _
           objAppt.End >= CDate(dtStart) And objAppt.Start <= CDate(dtEnd) Then
            ' Format を FormatDateTime に置き換え *10
            strLine = """" & objAppt.Subject & _
                """,""" & objAppt.Location & _
                """,""" & FormatDateTime(objAppt.Start, vbShortDate) & _
                """,""" & FormatDateTime(objAppt.Start, vbShortTime) & _
                """,""" & FormatDateTime(objAppt.End, vbShortDate) & _
                """,""" & FormatDateTime(objAppt.End, vbShortTime) & _
                """"
            ' Print を TextStream の WriteLine に置き換え *10
            stmCsvFile.WriteLine strLine
        End If
        If objAppt.Start >= dtEnd Then
            Exit For
        End If
    Next
    ' Close を TextStream の Close に置き換え *10
    stmCsvFile.Close
    ' ShellExecute が使用できないため、Excel で印刷 *9
    Dim objExcel 'As Excel.Application
    Dim objCsvWB 'As Excel.WorkBook
    Set objExcel = CreateObject("Excel.Application")
    Set objCsvWB = objExcel.WorkBooks.Open(CSV_FILE_NAME)
    objCsvWB.Windows(1).Activate
    objCsvWB.PrintOut
    objCsvWB.Close
    Set objCsvWB = Nothing
End Sub

コメントを残す