http://pnpk.netの記事を全くそのまま流用（一礼しながら大胆にパクり）でVirtualServerのオンラインバックアップが可能になった。
テキストファイルにログを書きだすように変更した。
このスクリプト（BackupVirtualServer.vbs）をタスクスケジューラで起動すれば完璧だ。
■結果
5つの仮想サーバ（総容量：89GB）が稼働している環境で、vbsを実行したところ2分30秒ですべてのバックアップが完了した。
この所要時間なら、深夜に実行と言わなくても、昼間の時間帯で実行できそうな気配。
ナイス！
※環境は以下
Windows 2003 Server Standard x64
Virtual Server 2005 R2 SP1
Intel VT
CPU:クアッドコアXeon2.3GHz*2CPU
メモリ：16GB
HDD:RAID1 15000回転SAS
以下、BackupVirtualServer.vbs
Option Explicit
Dim objVS,colVMS,objVM
Dim VM_STATE_RUNNING
Dim VM_STATE_SAVED
Dim dateStartTime
Dim dateEndTime
Dim dateTotalTime
Dim objFS
Dim objText
'ログファイル
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objText=objFS.CreateTextFile("VirtualServerBackupLog.txt")
'バックアップを保存するディレクトリ
Dim BKUP_Dir
'ゲストOSのVMCイメージが保存されている親ディレクトリ
Dim strGestOSDir
BKUP_Dir = "D:\VS\"
VM_STATE_RUNNING = 5
VM_STATE_SAVED = 2
'objVM.Stateの値説明
' 0: バーチャルマシンが存在しない
' 1: オフ
' 2: 保存済み
' 3: オン中
' 4: 復元中
' 5: 実行中
' 6: 一時停止
' 7: 保存中
' 8: オフ中
' 9: 復元ディスク適用中
'10 : バーチャルマシンが削除されている
Set objVS = CreateObject("VirtualServer.Application")
Set colVMS = objVS.VirtualMachines
For Each objVM in colVMS
'指定されたゲストOSが起動していた場合、状態の保存を行う。
If objVM.State = VM_STATE_RUNNING Then
'タイマー取得
dateStartTime = Timer
'状態の保存
objVM.Save
objText.WriteLine(Now() & " " & objVM.Name & " の状態の保存を行っています。")
'ゲストOSの状態が保存済みになるまで待機する。
Do Until objVM.State = VM_STATE_SAVED
WScript.Sleep 1000
Loop
strGestOSDir = GetParentFolderName(objVM.File)
'BKUP_Dirに対してゲストOSの親ディレクトリをコピー
Call CopyFolder(strGestOSDir,BKUP_Dir & "\" & objVM.Name)
objText.WriteLine(Now() & " " & objVM.Name & " のバックアップが完了しました。")
'ゲストOSを起動。
objVM.Startup()
objText.WriteLine(Now() & " " & objVM.Name & " を起動しています。")
'ゲストOSの状態が実行中になるまで待機する。
Do Until objVM.State = VM_STATE_RUNNING
WScript.Sleep 1000
Loop
'確認用
objText.WriteLine(Now() & " " & objVM.Name & " が起動しました。")
End If
'ファイル情報
'objText.WriteLine(Now() & " " & "親ディレクトリ" & GetParentFolderName(objVM.File))
'タイマー取得
dateEndTime = Timer
dateTotalTime = dateEndTime - dateStartTime
Next
objText.Close
'親ディレクトリ名を返す
Function GetParentFolderName(Path)
Dim objFS
Dim strParent
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
strParent = objFS.GetParentFolderName(Path)
GetParentFolderName = objFS.GetParentFolderName(Path)
Set objFS = Nothing
End Function
'参照元ディレクトリから参照先ディレクトリに対して上書きコピー
'CopyFolder(参照元ディレクトリ,参照先ディレクトリ)
Function CopyFolder(strSourceDIR,strDestinationDIR)
Dim objFS
Const OverWriteFiles = True
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
'参照先ディレクトリが無ければディレクトリを作成
Call CreateDir(strDestinationDIR)
'ディレクトリへのコピーは上書き
objFS.CopyFolder strSourceDIR,strDestinationDIR,OverWriteFiles
End Function
'ディレクトリを作成する
Sub CreateDir(Path)
Dim objFS
Dim strParent
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
strParent = objFS.GetParentFolderName(Path)
'親ディレクトリが無ければディレクトリを作成
If Not objFS.FolderExists(strParent) Then
Call CreateDir(strParent)
End If
If Not objFS.FolderExists(Path) Then
objFS.CreateFolder(Path)
End If
End Sub
