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

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

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

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

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

view plainprint?

1. '----  
2. ' Windowsのタスク スケジューラから指定された名前のタスクをXML形式で表示します。  
3. ' 標準出力にはログ、標準エラー出力にはXMLを出力します。  
4. ' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_list.vbs 1> tasks.log 2> tasks.xml  
5. '----  
6.   
7. Option Explicit  
8. Dim objShell  
9. Dim objExec   
10. Dim objDictionary  
11. Dim objFso  
12. Dim strLine  
13. Dim strCmd  
14. Dim Count  
15. Dim Name  
16. Dim QuitCode  
17. Const MINIMIZE_WINDOW = 2  
18. Const SCHTASKS = "C:\Windows\System32\SCHTASKS.EXE"  
19. Const KEYWORD = "スケジュール - "  
20.   
21. '----  
22. ' チェック関数  
23. '----  
24.   
25. Function CheckError(fnName)  
26.     CheckError = False  
27.       
28.     Dim strmsg  
29.     Dim errNum  
30.       
31.     If Err.Number <> 0 Then  
32.         strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description  
33.         WScript.Stdout.WriteLine strmsg  
34.         CheckError = True  
35.     End If  
36.            
37. End Function  
38.   
39. '----  
40. ' オブジェクト生成  
41. '----  
42.   
43. Set objShell = WScript.CreateObject("WScript.Shell")  
44. Set objDictionary = WScript.CreateObject("Scripting.Dictionary")  
45. Set objFso = WScript.CreateObject("Scripting.FileSystemObject")  
46.   
47. '----  
48. ' タスク一覧表示  
49. '----  
50.   
51. Sub Main()  
52.     Dim ExitCode  
53.     Dim ErrCount  
54.   
55.     '----  
56.     ' タスク一覧から削除対象のタスク名を取得  
57.     '----  
58.   
59.     Set objExec = objShell.Exec(SCHTASKS & " /query /fo:csv")  
60.     Count = 0  
61.     Do Until objExec.StdOut.AtEndOfStream  
62.         strLine = objExec.StdOut.ReadLine  
63.         If InStr(strLine, KEYWORD) <> 0 Then  
64.             Count = Count + 1  
65.             objDictionary.Add Count, Mid(strLine, 1, InStr(strLine, ""","))  
66.         End If  
67.     Loop  
68.     If objExec.ExitCode <> 0 Then  
69.         Do Until objExec.StdErr.AtEndOfStream  
70.             WScript.StdOut.WriteLine objExec.StdErr.ReadLine  
71.         Loop  
72.         Err.Raise(51)  
73.     End If  
74.     Set objExec = Nothing  
75.   
76.     '----  
77.     ' 件数を出力  
78.     '----  
79.   
80.     WScript.StdOut.WriteLine "NOTE: found " & Count & " tasks to export."  
81.   
82.     '----  
83.     ' タスクをXML形式で表示  
84.     '----  
85.   
86.     For Each Name In objDictionary.Keys  
87.         strCmd = SCHTASKS & " /query /xml /tn:" & objDictionary(Name)  
88.         WScript.StdOut.WriteLine strCmd  
89.         Set objExec = objShell.Exec(strCmd)  
90.         WScript.StdErr.WriteLine("<!-- begin " & objDictionary(Name) & " username=" &objShell.ExpandEnvironmentStrings("%USERNAME%") & " -->")  
91.         Do Until objExec.StdOut.AtEndOfStream  
92.             WScript.StdErr.WriteLine(objExec.StdOut.ReadLine)  
93.         Loop  
94.         WScript.StdErr.WriteLine("<!-- end " & objDictionary(Name) & " username=" &objShell.ExpandEnvironmentStrings("%USERNAME%") & " -->")  
95.   
96.         If objExec.ExitCode <> 0 Then  
97.             Do Until objExec.StdErr.AtEndOfStream  
98.                 WScript.StdOut.WriteLine objExec.StdErr.ReadLine  
99.             Loop  
100.             Err.Raise(51)  
101.         End If  
102.         Set objExec = Nothing  
103.     Next  
104.   
105. End Sub  
106.   
107. '----  
108. ' 処理実行  
109. '----  
110.   
111. Sub Try()  
112.     Call Main()  
113. End Sub  
114.   
115. '----  
116. ' エラー捕捉  
117. '----  
118.   
119. Sub Catch()  
120.     On Error Resume Next  
121.     Call Try()  
122. End Sub  
123.   
124. '----  
125. ' 処理実行  
126. '----  
127.   
128. QuitCode=0  
129. WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()  
130. Call Catch()  
131. If CheckError("Catch") Then  
132.     QuitCode = 1  
133. End If  
134.   
135. '----  
136. ' 終了  
137. '----  
138.   
139. Set objShell = Nothing  
140. Set objDictionary = Nothing  
141. Set objFso = Nothing  
142. WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode  
143. WScript.Quit QuitCode  

'----
' 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

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

view plainprint?

1. '----  
2. ' Windowsのタスク スケジューラから指定された名前のタスクを削除します。  
3. ' 標準出力に削除のログを出力します。  
4. ' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_delete.vbs > tasks_delete_%date:~-2,2%.log  
5. '----  
6.   
7. Option Explicit  
8. Dim objShell  
9. Dim objExec   
10. Dim objDictionary  
11. Dim objFso  
12. Dim strLine  
13. Dim strCmd  
14. Dim Count  
15. Dim Name  
16. Dim objFile  
17. Dim QuitCode  
18. Const SCSHTASKS = "C:\Windows\System32\SCHTASKS.EXE"  
19.   
20. '----  
21. ' 削除するタスク名の名前  
22. '----  
23.   
24. Const KEYWORD = "スケジュール - "  
25.   
26. '----  
27. ' チェック関数  
28. '----  
29.   
30. Function CheckError(fnName)  
31.     CheckError = False  
32.       
33.     Dim strmsg  
34.     Dim errNum  
35.       
36.     If Err.Number <> 0 Then  
37.         strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description  
38.         WScript.Stdout.WriteLine strmsg  
39.         CheckError = True  
40.     End If  
41.            
42. End Function  
43.   
44. '----  
45. ' オブジェクト生成  
46. '----  
47.   
48. Set objShell = WScript.CreateObject("WScript.Shell")  
49. Set objDictionary = WScript.CreateObject("Scripting.Dictionary")  
50. Set objFso = WScript.CreateObject("Scripting.FileSystemObject")  
51.   
52. '----  
53. ' タスク削除  
54. '----  
55.   
56. Sub Main()  
57.     Dim ExitCode  
58.     Dim ErrCount  
59.   
60.     '----  
61.     ' タスク一覧から削除対象のタスク名を取得  
62.     '----  
63.   
64.     Set objExec = objShell.Exec(SCSHTASKS & " /query /fo:csv")  
65.     Count = 0  
66.     Do Until objExec.StdOut.AtEndOfStream  
67.         strLine = objExec.StdOut.ReadLine  
68.         If InStr(strLine, KEYWORD) <> 0 Then  
69.             Count = Count + 1  
70.             objDictionary.Add Count, Mid(strLine, 1, InStr(strLine, ""","))  
71.         End If  
72.     Loop  
73.     If objExec.ExitCode <> 0 Then  
74.         Do Until objExec.StdErr.AtEndOfStream  
75.             WScript.StdOut.WriteLine objExec.StdErr.ReadLine  
76.         Loop  
77.         Err.Raise(51)  
78.     End If  
79.     Set objExec = Nothing  
80.   
81.     '----  
82.     ' 件数を出力  
83.     '----  
84.   
85.     WScript.StdOut.WriteLine "NOTE: found " & Count & " tasks to delete."  
86.   
87.     '----  
88.     ' タスクを削除  
89.     '----  
90.   
91.     For Each Name In objDictionary.Keys  
92.         strCmd = SCSHTASKS & " /delete /f /tn " & objDictionary(Name)  
93.         WScript.StdOut.WriteLine strCmd  
94.         Set objExec = objShell.Exec(strCmd)  
95.   
96.         Do Until objExec.StdOut.AtEndOfStream  
97.             WScript.StdOut.WriteLine objExec.StdOut.ReadLine  
98.         Loop  
99.   
100.         If objExec.ExitCode <> 0 Then  
101.             Do Until objExec.StdErr.AtEndOfStream  
102.                 WScript.StdOut.WriteLine objExec.StdErr.ReadLine  
103.             Loop  
104.             Err.Raise(51)  
105.         End If  
106.         Set objExec = Nothing  
107.     Next  
108.   
109. End Sub  
110.   
111. '----  
112. ' 処理実行  
113. '----  
114.   
115. Sub Try()  
116.     Call Main()  
117. End Sub  
118.   
119. '----  
120. ' エラー捕捉  
121. '----  
122.   
123. Sub Catch()  
124.     On Error Resume Next  
125.     Call Try()  
126. End Sub  
127.   
128. '----  
129. ' 処理実行  
130. '----  
131.   
132. QuitCode = 0  
133. WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()  
134. Call Catch()  
135. If CheckError("Catch") Then  
136.     QuitCode = 1  
137. End If  
138.   
139. '----  
140. ' 終了  
141. '----  
142.   
143. Set objShell = Nothing  
144. Set objDictionary = Nothing  
145. Set objFso = Nothing  
146. WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode  
147. 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ファイルからタスクを作成します。

view plainprint?

1. '----  
2. ' WindowsのタスクをXMLファイルから定義します。  
3. ' 引数に tasks_list.vbs で作成したXMLファイルを指定します。  
4. ' タスクの実行ユーザは、スクリプトの実行者に置き換えられます。  
5. ' 使用例: C:\Windows\System32\cscript //b c:\temp\tasks_create.vbs tasks.xml  
6. '----  
7.   
8. Option Explicit  
9. Dim objShell  
10. Dim objExec   
11. Dim objDictionary  
12. Dim objFso  
13. Dim strLine  
14. Dim strCmd  
15. Dim Count  
16. Dim Name  
17. Dim objFile  
18. Dim xmlFile  
19. Dim QuitCode  
20. Const SCSHTASKS = "C:\Windows\System32\SCHTASKS.EXE"  
21.   
22. '----  
23. ' 実行ユーザのキーワード  
24. '----  
25.   
26. Const KEYWORD = "      <userid>"  
27.   
28. '----  
29. ' チェック関数  
30. '----  
31.   
32. Function CheckError(fnName)  
33.     CheckError = False  
34.       
35.     Dim strmsg  
36.     Dim errNum  
37.       
38.     If Err.Number <> 0 Then  
39.         strmsg = "ERROE: #" & Hex(Err.Number) & " in module " & fnName & " " & Err.Description  
40.         WScript.Stdout.WriteLine strmsg  
41.         CheckError = True  
42.     End If  
43.            
44. End Function  
45.   
46. '----  
47. ' XMLのコメントからユーザ名を取得  
48. '----  
49.   
50. Function XmlUserName(Buf)  
51.     Dim Pos1, Pos2  
52.     Const Keyword1 = "username="  
53.     Const Keyword2 = " -->"  
54.   
55.     XmlUserName = "N/A"  
56.   
57.     Pos1 = InStr(Buf, Keyword1)  
58.     Pos2 = InStr(Buf, Keyword2)  
59.     If Pos1 <> 0 And Pos2 <> 0 Then  
60.         XmlUserName = Mid(Buf, Pos1 + Len(Keyword1), Pos2 - (Pos1 + Len(Keyword1)))  
61.     End If  
62. End Function  
63.   
64. '----  
65. ' XMLのコメントからタスク名を取得  
66. '----  
67.   
68. Function XmlTaskName(Buf)  
69.     Dim Pos1, Pos2  
70.     Dim AryStrings  
71.     Const Keyword1 = "<!-- end "  
72.     Const Keyword2 = "username="  
73.   
74.     XmlTaskName = "N/A"  
75.   
76.     Pos1 = InStr(Buf, Keyword1)  
77.     Pos2 = InStr(Buf, Keyword2)  
78.     If Pos1 <> 0 And Pos2 <> 0 Then  
79.         XmlTaskName = Trim(Mid(Buf, Pos1 + Len(Keyword1), Pos2 - (Pos1 + Len(Keyword1))))  
80.         XmlTaskName = Mid(XmlTaskName, 2, Len(XmlTaskName) - 2)  
81.   
82.         AryStrings = Split(XmlTaskName, "\")  
83.         XmlTaskName = AryStrings(UBound(AryStrings))  
84.     End If  
85. End Function  
86.   
87. '----  
88. ' オブジェクト生成  
89. '----  
90.   
91. Set objShell = WScript.CreateObject("WScript.Shell")  
92. Set objDictionary = WScript.CreateObject("Scripting.Dictionary")  
93. Set objFso = WScript.CreateObject("Scripting.FileSystemObject")  
94.   
95. '----  
96. ' タスク定義  
97. '----  
98.   
99. Sub Main()  
100.     Dim UserName  
101.     Dim TaskName  
102.     Dim FilePath  
103.   
104.     '----  
105.     ' テンポラリファイルのパスを設定  
106.     '----  
107.     FilePath = objShell.ExpandEnvironmentStrings("%TEMP%") & "\task.xml"  
108.   
109.     '----  
110.     ' 引数のXMLファイルを開く  
111.     '----  
112.     If WScript.Arguments.Count <> 1 Then  
113.         Err.Rase(51)  
114.     End If  
115.     Set objFile = objFso.OpenTextFile(WScript.Arguments.Item(0))  
116.   
117.     Count = 0  
118.     strLine = objFile.ReadLine  
119.     Do Until objFile.AtEndOfStream  
120.         If InStr(strLine, "<!-- begin") <> 0 Then  
121.             Set xmlFile = objFSO.OpenTextFile(FilePath, 2, True)  
122.             strLine = objFile.ReadLine  
123.             Do Until objFile.AtEndOfStream or (InStr(strLine, "<!-- end") <> 0)  
124.                 ' ユーザIDを書き換える  
125.                 If InStr(strLine, KEYWORD) = 1 Then  
126.                     strLine = "      <userid>" & objShell.ExpandEnvironmentStrings("%USERDOMAIN%") & "\" & objShell.ExpandEnvironmentStrings("%USERNAME%") & "</userid>"  
127.                 End If  
128.                 xmlFile.WriteLine strLine  
129.                 strLine = objFile.ReadLine  
130.             Loop  
131.             UserName = xmlUserName(strLine)  
132.             TaskName = xmlTaskName(strLine)  
133.             xmlFile.Close  
134.   
135.             '----  
136.             ' タスク登録  
137.             '----  
138.             Count = Count + 1  
139.             strCmd = SCSHTASKS & " /create /xml """ & FilePath & """ /tn:""EG\" & UserName & "." & Right("000" & Count, 3) & " " & TaskName & """"  
140.             WScript.StdOut.WriteLine strCmd  
141.             Set objExec = objShell.Exec(strCmd)  
142.   
143.             Do Until objExec.StdOut.AtEndOfStream  
144.                 WScript.StdOut.WriteLine objExec.StdOut.ReadLine  
145.             Loop  
146.             If objExec.ExitCode <> 0 Then  
147.                 Do Until objExec.StdErr.AtEndOfStream  
148.                     WScript.StdOut.WriteLine objExec.StdErr.ReadLine  
149.                 Loop  
150.                 Err.Raise(51)  
151.             End If  
152.             Set objExec = Nothing  
153.   
154.         End If  
155.         If objFile.AtEndOfStream = False Then  
156.             strLine = objFile.ReadLine  
157.         End If  
158.     Loop  
159.   
160.     '----  
161.     ' 件数を出力  
162.     '----  
163.   
164.     WScript.StdOut.WriteLine "NOTE: create " & Count & " tasks."  
165.   
166.     '----  
167.     ' テンポラリのXMLファイルを削除  
168.     '----  
169.     objFso.DeleteFile FilePath, True  
170.   
171. End Sub  
172.   
173. '----  
174. ' 処理実行  
175. '----  
176.   
177. Sub Try()  
178.     Call Main()  
179. End Sub  
180.   
181. '----  
182. ' エラー捕捉  
183. '----  
184.   
185. Sub Catch()  
186.     On Error Resume Next  
187.     Call Try()  
188. End Sub  
189.   
190. '----  
191. ' 処理実行  
192. '----  
193.   
194. QuitCode = 0  
195. WScript.StdOut.WriteLine "NOTE: script=" & WScript.ScriptFullName & " date=" & Now()  
196. Call Catch()  
197. If CheckError("Catch") Then  
198.     QuitCode = 1  
199. End If  
200.   
201. '----  
202. ' 終了  
203. '----  
204.   
205. Set objShell = Nothing  
206. Set objDictionary = Nothing  
207. Set objFso = Nothing  
208. WScript.StdOut.WriteLine "NOTE: script finished with exit code " & QuitCode  
209. WScript.Quit QuitCode  
210.   
211.   
212.   
213. </userid>  

'----
' 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

RPM - Rapid Predictive Modeler

10年ぶりのEnterprise Miner

久しぶりにEnterprise Minerを使ったら、RPMなる便利な機能が付いてました。10年以上前にSAS Enterprise Minerのトレーニングを受けたものの、仕事ではSPSS Modeler(Clementine)ばかりを使っていました。しばらく会えなかった友人（又は恋人）に再開したような気持ちです。

RPMとは何か？

Enterprise Guideのデータに対して目的変数、説明変数を設定し、予測モデルを作ってくれる機能です。データ加工はEGの上で行って、EMのプロジェクトはRPMで作ることができます。モデル作成の機能が割り切りよく、基本、中間、詳細の3段階というのが良いです。

できたモデルをEGから参照して、スコアリングできます。細かい調整をしたい人は、EMからプロジェクトを開いて修正します。モデル作成で詳細を指定すると、回帰、決定木と複数のモデルを作成して比較してくれます。とはいえ、実際に使うモデルの手法は、業務や分析者で決まってしまうとは思いますが。

Rev up your RPMs; A Modeling Sampler動画

RPMがどんなものかは、下の動画を見れば、一目瞭然かと思います。
Part 1
Part 2
Part 3