VBScriptでタスクスケジューラの複数のタスクをXMLに出力、削除、作成

EGで登録したスケジュールのタスクを、他のユーザへ定期的に引き渡すためにVBScriptを組みました。特定のタスクをXMLファイルに出力、削除、登録します。

SCHTASKSを使っていますが、これ１つの操作で１タスクしか定義できません。じゃあPowerShellで書こうかと思ったのですが、お客様先の環境だと使えないことが多いためVBScriptで書きました。

• tasks_list.vbs でXMLファイルを作成
• tasks_delete.vbs でタスクを削除
• tasks_create.vbs でタスクを作成

キーワードを含む名前のタスクをXML形式で出力します。

'----
' Windowsのタスク スケジューラから指定された名前のタスクをXML形式で表示します。
' 標準出力にはログ、標準エラー出力にはXMLを出力します。
' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_list.vbs 1> tasks.log 2> tasks.xml
'----

Option Explicit
Dim objShell
Dim objExec 
Dim objDictionary
Dim objFso
Dim strLine
Dim strCmd
Dim Count
Dim Name
Dim QuitCode
Const MINIMIZE_WINDOW = 2
Const SCHTASKS = "C:\Windows\System32\SCHTASKS.EXE"
Const KEYWORD = "スケジュール - "

'----
' チェック関数
'----

Function CheckError(fnName)
    CheckError = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description
        WScript.Stdout.WriteLine strmsg
        CheckError = True
    End If
         
End Function

'----
' オブジェクト生成
'----

Set objShell = WScript.CreateObject("WScript.Shell")
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'----
' タスク一覧表示
'----

Sub Main()
    Dim ExitCode
    Dim ErrCount

    '----
    ' タスク一覧から削除対象のタスク名を取得
    '----

    Set objExec = objShell.Exec(SCHTASKS & " /query /fo:csv")
    Count = 0
    Do Until objExec.StdOut.AtEndOfStream
        strLine = objExec.StdOut.ReadLine
        If InStr(strLine, KEYWORD) <> 0 Then
            Count = Count + 1
            objDictionary.Add Count, Mid(strLine, 1, InStr(strLine, ""","))
        End If
    Loop
    If objExec.ExitCode <> 0 Then
        Do Until objExec.StdErr.AtEndOfStream
            WScript.StdOut.WriteLine objExec.StdErr.ReadLine
        Loop
        Err.Raise(51)
    End If
    Set objExec = Nothing

    '----
    ' 件数を出力
    '----

    WScript.StdOut.WriteLine "NOTE: found " & Count & " tasks to export."

    '----
    ' タスクをXML形式で表示
    '----

    For Each Name In objDictionary.Keys
        strCmd = SCHTASKS & " /query /xml /tn:" & objDictionary(Name)
        WScript.StdOut.WriteLine strCmd
        Set objExec = objShell.Exec(strCmd)
        WScript.StdErr.WriteLine("")
        Do Until objExec.StdOut.AtEndOfStream
            WScript.StdErr.WriteLine(objExec.StdOut.ReadLine)
        Loop
        WScript.StdErr.WriteLine("")

        If objExec.ExitCode <> 0 Then
            Do Until objExec.StdErr.AtEndOfStream
                WScript.StdOut.WriteLine objExec.StdErr.ReadLine
            Loop
            Err.Raise(51)
        End If
        Set objExec = Nothing
    Next

End Sub

'----
' 処理実行
'----

Sub Try()
    Call Main()
End Sub

'----
' エラー捕捉
'----

Sub Catch()
    On Error Resume Next
    Call Try()
End Sub

'----
' 処理実行
'----

QuitCode=0
WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()
Call Catch()
If CheckError("Catch") Then
    QuitCode = 1
End If

'----
' 終了
'----

Set objShell = Nothing
Set objDictionary = Nothing
Set objFso = Nothing
WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode
WScript.Quit QuitCode

特定の名前のタスクを削除します。

'----
' Windowsのタスク スケジューラから指定された名前のタスクを削除します。
' 標準出力に削除のログを出力します。
' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_delete.vbs > tasks_delete_%date:~-2,2%.log
'----

Option Explicit
Dim objShell
Dim objExec 
Dim objDictionary
Dim objFso
Dim strLine
Dim strCmd
Dim Count
Dim Name
Dim objFile
Dim QuitCode
Const SCSHTASKS = "C:\Windows\System32\SCHTASKS.EXE"

'----
' 削除するタスク名の名前
'----

Const KEYWORD = "スケジュール - "

'----
' チェック関数
'----

Function CheckError(fnName)
    CheckError = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description
        WScript.Stdout.WriteLine strmsg
        CheckError = True
    End If
         
End Function

'----
' オブジェクト生成
'----

Set objShell = WScript.CreateObject("WScript.Shell")
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'----
' タスク削除
'----

Sub Main()
    Dim ExitCode
    Dim ErrCount

    '----
    ' タスク一覧から削除対象のタスク名を取得
    '----

    Set objExec = objShell.Exec(SCSHTASKS & " /query /fo:csv")
    Count = 0
    Do Until objExec.StdOut.AtEndOfStream
        strLine = objExec.StdOut.ReadLine
        If InStr(strLine, KEYWORD) <> 0 Then
            Count = Count + 1
            objDictionary.Add Count, Mid(strLine, 1, InStr(strLine, ""","))
        End If
    Loop
    If objExec.ExitCode <> 0 Then
        Do Until objExec.StdErr.AtEndOfStream
            WScript.StdOut.WriteLine objExec.StdErr.ReadLine
        Loop
        Err.Raise(51)
    End If
    Set objExec = Nothing

    '----
    ' 件数を出力
    '----

    WScript.StdOut.WriteLine "NOTE: found " & Count & " tasks to delete."

    '----
    ' タスクを削除
    '----

    For Each Name In objDictionary.Keys
        strCmd = SCSHTASKS & " /delete /f /tn " & objDictionary(Name)
        WScript.StdOut.WriteLine strCmd
        Set objExec = objShell.Exec(strCmd)

        Do Until objExec.StdOut.AtEndOfStream
            WScript.StdOut.WriteLine objExec.StdOut.ReadLine
        Loop

        If objExec.ExitCode <> 0 Then
            Do Until objExec.StdErr.AtEndOfStream
                WScript.StdOut.WriteLine objExec.StdErr.ReadLine
            Loop
            Err.Raise(51)
        End If
        Set objExec = Nothing
    Next

End Sub

'----
' 処理実行
'----

Sub Try()
    Call Main()
End Sub

'----
' エラー捕捉
'----

Sub Catch()
    On Error Resume Next
    Call Try()
End Sub

'----
' 処理実行
'----

QuitCode = 0
WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()
Call Catch()
If CheckError("Catch") Then
    QuitCode = 1
End If

'----
' 終了
'----

Set objShell = Nothing
Set objDictionary = Nothing
Set objFso = Nothing
WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode
WScript.Quit QuitCode

XMLファイルからタスクを作成します。

'----
' WindowsのタスクをXMLファイルから定義します。
' 引数に tasks_list.vbs で作成したXMLファイルを指定します。
' タスクの実行ユーザは、スクリプトの実行者に置き換えられます。
' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_create.vbs tasks.xml
'----

Option Explicit
Dim objShell
Dim objExec 
Dim objDictionary
Dim objFso
Dim strLine
Dim strCmd
Dim Count
Dim Name
Dim objFile
Dim xmlFile
Dim QuitCode
Const SCSHTASKS = "C:\Windows\System32\SCHTASKS.EXE"

'----
' 実行ユーザのキーワード
'----

Const KEYWORD = "      "

'----
' チェック関数
'----

Function CheckError(fnName)
    CheckError = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description
        WScript.Stdout.WriteLine strmsg
        CheckError = True
    End If
         
End Function

'----
' XMLのコメントからユーザ名を取得
'----

Function XmlUserName(Buf)
    Dim Pos1, Pos2
    Const Keyword1 = "username="
    Const Keyword2 = " -->"

    XmlUserName = "N/A"

    Pos1 = InStr(Buf, Keyword1)
    Pos2 = InStr(Buf, Keyword2)
    If Pos1 <> 0 And Pos2 <> 0 Then
        XmlUserName = Mid(Buf, Pos1 + Len(Keyword1), Pos2 - (Pos1 + Len(Keyword1)))
    End If
End Function

'----
' XMLのコメントからタスク名を取得
'----

Function XmlTaskName(Buf)
    Dim Pos1, Pos2
    Dim AryStrings
    Const Keyword1 = "<!-- end "
    Const Keyword2 = "username="

    XmlTaskName = "N/A"

    Pos1 = InStr(Buf, Keyword1)
    Pos2 = InStr(Buf, Keyword2)
    If Pos1 <> 0 And Pos2 <> 0 Then
        XmlTaskName = Trim(Mid(Buf, Pos1 + Len(Keyword1), Pos2 - (Pos1 + Len(Keyword1))))
        XmlTaskName = Mid(XmlTaskName, 2, Len(XmlTaskName) - 2)

        AryStrings = Split(XmlTaskName, "\")
        XmlTaskName = AryStrings(UBound(AryStrings))
    End If
End Function

'----
' オブジェクト生成
'----

Set objShell = WScript.CreateObject("WScript.Shell")
Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")

'----
' タスク定義
'----

Sub Main()
    Dim UserName
    Dim TaskName
    Dim FilePath

    '----
    ' テンポラリファイルのパスを設定
    '----
    FilePath = objShell.ExpandEnvironmentStrings("%TEMP%") & "\task.xml"

    '----
    ' 引数のXMLファイルを開く
    '----
    If WScript.Arguments.Count <> 1 Then
        Err.Rase(51)
    End If
    Set objFile = objFso.OpenTextFile(WScript.Arguments.Item(0))

    Count = 0
    strLine = objFile.ReadLine
    Do Until objFile.AtEndOfStream
        If InStr(strLine, "<!-- begin") <> 0 Then
            Set xmlFile = objFSO.OpenTextFile(FilePath, 2, True)
            strLine = objFile.ReadLine
            Do Until objFile.AtEndOfStream or (InStr(strLine, "<!-- end") <> 0)
                ' ユーザIDを書き換える
                If InStr(strLine, KEYWORD) = 1 Then
                    strLine = "      " & objShell.ExpandEnvironmentStrings("%USERDOMAIN%") & "\" & objShell.ExpandEnvironmentStrings("%USERNAME%") & ""
                End If
                xmlFile.WriteLine strLine
                strLine = objFile.ReadLine
            Loop
            UserName = xmlUserName(strLine)
            TaskName = xmlTaskName(strLine)
            xmlFile.Close

            '----
            ' タスク登録
            '----
            Count = Count + 1
            strCmd = SCSHTASKS & " /create /xml """ & FilePath & """ /tn:""EG\" & UserName & "." & Right("000" & Count, 3) & " " & TaskName & """"
            WScript.StdOut.WriteLine strCmd
            Set objExec = objShell.Exec(strCmd)

            Do Until objExec.StdOut.AtEndOfStream
                WScript.StdOut.WriteLine objExec.StdOut.ReadLine
            Loop
            If objExec.ExitCode <> 0 Then
                Do Until objExec.StdErr.AtEndOfStream
                    WScript.StdOut.WriteLine objExec.StdErr.ReadLine
                Loop
                Err.Raise(51)
            End If
            Set objExec = Nothing

        End If
        If objFile.AtEndOfStream = False Then
            strLine = objFile.ReadLine
        End If
    Loop

    '----
    ' 件数を出力
    '----

    WScript.StdOut.WriteLine "NOTE: create " & Count & " tasks."

    '----
    ' テンポラリのXMLファイルを削除
    '----
    objFso.DeleteFile FilePath, True

End Sub

'----
' 処理実行
'----

Sub Try()
    Call Main()
End Sub

'----
' エラー捕捉
'----

Sub Catch()
    On Error Resume Next
    Call Try()
End Sub

'----
' 処理実行
'----

QuitCode = 0
WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()
Call Catch()
If CheckError("Catch") Then
    QuitCode = 1
End If

'----
' 終了
'----

Set objShell = Nothing
Set objDictionary = Nothing
Set objFso = Nothing
WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode
WScript.Quit QuitCode

EGPからログを抽出するVBScript

EGPからログを抽出するスクリプトを作りました。EGPをZIPのファイルにコピーして、そのなかからresult.logのファイルを特定し、1つのファイルに出力しています。この方法は、公式ではなくNon Supportです。EGPのファイルが壊れたときに救済手段として、どこかに紹介されていました。
DebugFlag = Trueだと、メッセージのダイアログを表示します。あと、ログファイルの並び順は意識していません。

'---
' プログラム: EGPのファイルからSASログを抽出します。
'       説明: EGPの拡張子をZIPに変更して、ZIPのフォルダからresult.logのファイルを抽出
'     作成者: mining
'
'      引数1: EGPのファイルパス
'      引数2: ログファイルのパス
'     実行例: cscript foo.vbs C:\temp\foo.egp C:\temp\foo.log
'
'---

Option Explicit
On Error Resume Next

'---
' 定数
'---

Const FOF_SILENT = &H4              ' 進捗ダイアログを表示しない
Const FOF_NOCONFIRMATION = &H10     ' 上書き確認ダイアログを表示しない
Const ForWriting = 2                ' テキストファイルのオープン
Const ForReading = 1                ' テキストファイルのオープン
Const TristateUseDefault = -2       ' Opens the file using the system default.
Const TristateTrue = -1             ' Opens the file as Unicode.
Const TristateFalse = 0             ' Opens the file as ASCII.
Const DebugFlag = True

'---
' 変数
'---

Dim objShell
Dim objFso
Dim objTs
Dim sZipFile
Dim sTempFolder
Dim sEgpFilePath
Dim sLogFilePath
Dim ErrCount
Dim WarCount
Dim sMsg

'---
' オブジェクト生成します。
'---

Set objShell = CreateObject("Shell.Application")
Set objFso = CreateObject("Scripting.FileSystemObject")

'---
' 引数をチェックします。
'--

If WScript.Arguments.Count <> 2 Then
    Call MsgBox("引数1にEGP、引数2にログファイルを指定してください。", vbOKOnly + vbExclamation, WScript.ScriptName)
    WScript.Quit(1)
End If

sEgpFilePath = WScript.Arguments.Item(0)
sLogFilePath = WScript.Arguments.Item(1)

If objFso.FileExists(sEgpFilePath) = False Then
    Call MsgBox("引数1で指定したファイルが存在しません。", vbOKOnly + vbExclamation, WScript.ScriptName)
    WScript.Quit(1)
End If

'---
'   デバッグ用のメッセージ出力
'---

Sub DebugMsg(msg)
    If DebugFlag = True Then
        Call MsgBox(msg, vbOKOnly + vbInformation, WScript.ScriptName)
    End If
End Sub


'---
'   ZIPファイルを指定したフォルダに解凍
'---

Sub Unzip(objShell, sFile, sFolder)
    Dim objFilesInZip
    Dim objFolder
    
    Set objFilesInZip = objShell.Namespace(sFile).Items
    If Err.Number <> 0 Then
        Exit Sub
    End If
    Set objFolder = objShell.Namespace(sFolder)
    If Err.Number <> 0 Then
        Exit Sub
    End If
    
    If (Not objFolder Is Nothing) Then
        objFolder.CopyHere objFilesInZip, FOF_NOCONFIRMATION + FOF_SILENT
    Else
 Err.Raise 432 ' オートメーションの操作中にファイル名またはクラス名を見つけられませんでした。
    End If

   Set objFilesInZip = Nothing
   Set objFolder = Nothing
End Sub

'---
'   フォルダを作成
'---

Sub CreateUnzipFolder(objFso, sFolder)
    objFso.CreateFolder sFolder
End Sub

'---
'   フォルダを削除
'---

Sub DeleteUnzipFolder(objFso, sFolder)
    If objFso.FolderExists(sFolder) = True Then
        objFso.DeleteFolder sFolder, True
    End If
End Sub

'---
'   テンポラリのフォルダのパスを作成
'---

Function CreateFolderPath(objFso, sFolder)
    Const TemporaryFolder = 2
    Dim objTempFolder
    
    Set objTempFolder = objFso.GetSpecialFolder(TemporaryFolder)
    CreateFolderPath = objFso.BuildPath(objTempFolder.Path, sFolder)
    Set objTempFolder = Nothing
End Function

'---
'   サブフォルダからresult.logを探して、objTsに出力
'---

Sub SearchLog(objFso, objTs, tmpFolderItems)
    Const FileName = "result.log"
    Dim objFolderItemsB
    Dim objItem
    Dim Stream
    
    For Each objItem in tmpFolderItems
    
        ' 取り出した物がファイルかフォルダかを判定
        If objItem.IsFolder Then
            ' フォルダであれば、再帰呼び出しでフォルダ階層を手繰ります。
            Set objFolderItemsB = objItem.GetFolder
            Call SearchLog(objFso, objTs, objFolderItemsB.Items())
        ElseIf objItem.Name = FileName Then
            ' ファイル名が一致したら、テキストを読み取りobjTSに出力します。
            Set Stream = CreateObject("ADODB.Stream")
            Stream.Charset = "UTF-8"
            Stream.Type = 2
            Stream.Open
            Stream.LoadFromFile(objItem.Path)
            objTs.Write(Stream.ReadText)
            Stream.Close
            Set Stream = Nothing
        End If
    
    Next
    
    Set objItem = Nothing
    Set objFolderItemsB = Nothing

End Sub

'---
'   ログファイルからERROR, WARNINGの件数をカウント
'---

Sub CountLog(objFso, sLogFile, byRef ErrCount, byRef WarCount)
    Const KeyError = "e ERROR"
    Const KeyWarning = "w WARNING"
    Dim objTs
    Dim sBuf

    On Error Goto 0

    ErrCount = 0
    WarCount = 0

    Set objTs = objFso.OpenTextFile(sLogFile, ForReading, False, TristateTrue)
    If Err.Number <> 0 Then
        Exit Sub
    End If

    Do Until objTs.AtEndOfLine = True
        sBuf = objTs.ReadLine
        If Left(sBuf, Len(KeyError)) = KeyError Then
            ErrCount = ErrCount + 1
        ElseIf Left(sBuf, Len(KeyWarning)) = KeyWarning Then
            WarCount = WarCount + 1
        End If
    Loop

    objTs.Close
    If Err.Number <> 0 Then
        Exit Sub
    End If

    Set objTs = Nothing

End Sub

'---
' エラーチェック
'---

Function CheckError(fnName)
    Checkerror = False
    
    Dim strmsg
    Dim errNum
    
    If Err.Number <> 0 Then
        strmsg = "Error #" & Hex(Err.Number) & vbCrLf & "In Function " & fnName & vbCrLf & Err.Description
        Call MsgBox(strmsg, vbOkOnly + vbCritical, WScript.ScriptName)
        Checkerror = True
    End If
         
End Function

'---
' ログファイルを開きます。
'---

Set objTs = objFso.CreateTextFile(sLogFilePath, True, True)
If CheckError("objFso.CreateTextFile") Then
    WScript.Quit(1)
End If

'---
' EGPの拡張子をZIPに変更してコピーします。
'---

sZipFile = CreateFolderPath(objFso, objFso.GetTempName & ".zip")
Call DebugMsg("EGPの拡張子をZIPに変えてコピー:" & sZipFile)
objFso.CopyFile sEgpFilePath, sZipFile
If CheckError("objFso.CopyFile") Then
    WScript.Quit(1)
End If

'---
' 解凍先のテンポラリのフォルダを作成します。
'---

sTempFolder = CreateFolderPath(objFso, objFso.GetTempName)
Call DebugMsg("テンポラリのフォルダを作成:" & sTempFolder)
Call CreateUnzipFolder(objFso, sTempFolder)
If CheckError("CreateUnzipFolder") Then
    WScript.Quit(1)
End If


'---
' ZIPファイルを解凍します。
'---

Call DebugMsg("ZIPファイルを解凍:" & sZipFile)
Call Unzip(objShell, sZipFile, sTempFolder)
If CheckError("Unzip") Then
    WScript.Quit(1)
End If


'---
' テンポラリフォルダからログファイル探してobjTSに出力します。
'---

Call DebugMsg("テンポラリのフォルダからログを収集:" & sTempFolder)
Call SearchLog(objFso, objTs, (objShell.NameSpace(sTempFolder)).Items)
If CheckError("SearchLog") Then
    WScript.Quit(1)
End If

'---
' ログファイルを閉じます。
'---

objTs.Close
If CheckError("objTs.Close") Then
    WScript.Quit(1)
End If

'---
' テンポラリのフォルダを削除します。
'---

Call DebugMsg("テンポラリのフォルダを削除:" & sTempFolder)
Call DeleteUnzipFolder(objFso, sTempFolder)
If CheckError("DeleteUnzipFolder") Then
    WScript.Quit(1)
End If

'---
' ZIPファイルを削除します。
'---

Call DebugMsg("ZIPファイルを削除:" & sZipFile)
objFso.DeleteFile sZipFile
If CheckError("objFso.DeleteFile") Then
    WScript.Quit(1)
End If

'---
' Error, Warningの件数を数えます。
'---

Call CountLog(objFso, sLogFilePath, ErrCount, WarCount)
If CheckError("objFso.DeleteFile") Then
    WScript.Quit(1)
End If
Call DebugMsg("ERROR件数:" & CStr(ErrCount) & " WARNING件数:" & CStr(WarCount))

'---
' オブジェクトを破棄します。
'---

Set objTs = Nothing
Set objFso = Nothing
Set objShell = Nothing

'---
' 終了
'---

WScript.Quit(0)

EGPからログを取り出す方法

SAS Enterprise Guide Projectファイルからログを取り出す方法を調べました。調べてみるといくつか技術的な課題あり、てこずったのでここに記しておきます。EGのバージョンは7.1です。さて、その方法ですが、4種類みつけました。

1. OLE AutomationでVBScriptやPowerShellから取り出す
2. EGのツール、オプションでカスタムコードを書いてログの出力先を変える
3. EGPの拡張子をZIPに変えて、フォルダの中からログを取り出す
4. EGのツール、オプション、Application Loggingでログを出力する

OLE AutomationからVBSやPowerShellでログを取り出す

この方法は、スケジューリングで出力されるVBSのファイルを開いて、手を加えればできます。しかしながら、クエリ、コードタスク以外のログが取れませんでした。ProjectItemsの中をループで探りましたがランクや転置などデータ加工のタスク、グラフ作成のタスクが捕捉できませんでした。何故かは分かっていませんが、そういう実装なのだと割り切って考えています。

EGのツール、オプションでカスタムコードを書いてログの出力先を変える

proc printtoでログの出力先を変えます。この方法が使えるかと思いきや、クライアント/サーバ構成だとログがサーバ上に出力されて、クライアントPCから参照するためにもう一工夫必要になりあます。サーバ側でログの加工をするのであれば、問題ありません。カスタムのコードを設定する箇所が複数ありますが、使い分けは調べてください。

EGPの拡張子をZIPに変えて、フォルダの中からログを取り出す

元ネタはココの記事です。試してみると、サブフォルダのなかにresult.logがありますので、これをピックアップすればログを抽出できます。サブフォルダの中を見ると、削除されたと思しきタスクの殻フォルダがいくつかあります。ゴミがあるやも知れないので、この方法を使うときには検証をしてください。Non Supportです。

Tools、Options、Application Loggingでログを出力する

元ネタはココです。カスタムコードでproc printtoと似ていますが、サーバが出力するコード以外のログが含まれます。


EGPからログを取り出すときの検討項目を挙げます。

• プロジェクトファイル名を取得するか否か
• ログは時系列で取り出す必要があるか
• SASログ以外のログが含まれても良いか
• ログの出力先はローカルのPC、又はサーバ上？
• 抽出するファイルは1本にまとめるか、複数バラバラで良いか？

参考まで

Peek at your data using VBScript, OLE DB, and the SAS local data provider

SAS Local Data Providerを使って、SASデータセットの情報を読み取るサンプルコードです。元ネタはココですが、貼り付けるときにバックスラッシュが化けたのかそのままでは動きませんでした。少し手直ししています。SAS.EXEを起動しなくてもOKというのが軽くて良いのですが、果たして何に使うかは思案中です。Delphiで作るツールに役立つかも。

path = "C:\Program Files\SASHome\x86\SASEnterpriseGuide\4.3\Sample\Data"
filename = "Candy_Sales_Summary"

WScript.Echo "Path specified: " & path
WScript.Echo "File name : " & filename

' Check registry for SAS Local Provider
Set WSHShell = CreateObject("WScript.Shell")
clsID = WSHShell.RegRead("HKEY_CLASSES_ROOT\sas.LocalProvider\CLSID\")
'clsID = WSHShell.RegRead("HKCRSAS.LocalProviderCLSID")
WScript.Echo "DIAGNOSTICS: SAS.LocalProvider CLSID is " & clsID
inProcServer = WSHShell.RegRead("HKCR\CLSID\" & clsID & "\InprocServer32\")
WScript.Echo "DIAGNOSTICS: Registered InprocServer32 DLL is " & inProcServer

' Constants for ADO calls
Const adOpenDynamic = 2
Const adLockOptimistic = 3
Const adCmdTableDirect = 512

' Instantiate the provider object
Set obConnection = CreateObject("ADODB.Connection")
Set obRecordset = CreateObject("ADODB.Recordset")

obConnection.Provider = "SAS.LocalProvider"
obConnection.Properties("Data Source") = path
obConnection.Open
obRecordset.Open filename, obConnection, adOpenDynamic, adLockOptimistic, adCmdTableDirect

'Report on Fields in this data set
WScript.Echo ""
WScript.Echo "Opened data " & filename & ", Record count: " & obRecordset.RecordCount
For Each Field In obRecordset.Fields
If Field.Type = 5 Then pType = "Numeric"
If Field.Type = 200 Then pType = "Character"
WScript.Echo Field.Name & " " & pType
Next

obRecordset.Close
obConnection.Close

SASとVBScriptの連携

仕事柄VBScriptとSAS.EXEを連携することが多くあります。 サンプルコードを貼って、LanguageService Objectの資料をリンクしておきます。

'---
'    SASワークスペース・オブジェクトの生成
'---

Set oWrkSp = WScript.CreateObject("SAS.Workspace")

'---
'    ランゲージ・サービスの取得
'---
Set oLngSp = oWrkSp.LanguageService

'---
'    プログラムの実行
'---

oLngSp.Submit "data class; set sashelp.class; run; proc print; run;"

'---
'    ログの表示
'---
MsgBox oLngSp.FlushLog(100000)

'---
'    アウトプットの表示
'---

MsgBox oLngSp.FlushList(100000)

'---
'    ワークスペースを閉じる
'---

oWrkSp.Close
Set oWrkSp = Nothing

WScript.Quit(0)