ITの道具箱

社内システムの開発、運用、管理のためのヒント集？です。
これらの記述は、ある特定の環境下におけるものですから、
コード等の利用は自己責任でお願いします。

（更新日：2014/05/22）

◆閑話休題 (12)◆　OKI DATA のカラープリンタは 5 年保証とフォームオーバレイの機能がうれしい

JDL のカラーレーザープリンタ LP3630COLOR（カシオの OEM）に「メンテナンス時期」というメッセージが表示されました。さっそく修理（部品交換）の見積りをとったところ、30万円超だったので買い換えることにしました。
検討した結果、沖データの COREFIDO C811dn にしました。沖データの製品は初めてですが、決め手は 5 年間無償保証・メンテナンス品 5 年間無償提供でした。
トレイユニットは計 3 段ですが、考えていたよりも安く調達できました。コンパクトで、保守性もよいのでたいへん満足しています。
欠点はドライバに不具合があることで、Adobe Reader などの印刷ダイアログで「両面印刷」を指定しても両面印刷されない現象がでます。このときドライバの印刷設定を見ると、両面ユニットが搭載されていないように両面印刷の項目がなかったり、両面印刷にチェックが入っていなかったりします。ドライバの設定をいじるようなアプリケーションで発生するようです。沖データでもこの現象は把握しているようですから、早いとこ修正したドライバがでることを期待しましょう。
また、トナーカートリッジは交換のときにトナーがこぼれるのが難ですが、コンパクトさを優先した結果なのでしょうか。

ところで、購入してから気がついたのですが C811dn にはフォームオーバレイの機能があるのです。
フォームオーバレイというとフォームを作成する専用ソフトが必要（しかも高価）であるという認識でいたのですが、これは違いました。
SD メモリーカードキット（税抜定価 20,000 円）が必要なだけです
ドキュメントの印刷でファイルとして保存すればフォームとなり、それを Configuration Tool の Storage Manager というユーティリティでプリンタの SD カードに転送します。あとは、重ね合わせる内容を作成してからドライバでフォームオーバレイの ID を指定するだけ。実に簡単で実用的です。
詳しくは沖データのサイトにあるフォームオーバレイの概要の PDF ファイルをご覧ください。
一般的にはフォームオーバレイを使用するような場面はめったにないでしょうが、私どもでは前々から必要としていたのです。さっそく「青色申告決算書（農業所得用）」でフォームオーバレイを使用しました（画像）。
決算書は 4 ページで 1 組なのですが、複数ページのフォームオーバレイもまったく問題ありません。両面印刷も当然できます。
背景の「青色申告決算書（農業所得用）」は国税庁のサイトにある PDF から印刷ファイルにしてプリンタの SD カードに保存し、重ね合わせる内容は帳票ソフトのワンダフルレポート 2000 でフォーマットしています。
これまでは背景部分もワンダフルレポートでデザインしていたので、フォームとデータでぐちゃぐちゃでした（画像）。しかも、今年は帳票デザインに一部変更があることがわかっていたので対応に悩ませていました。沖データさんに感謝です。電話サポートの対応もよいですし（フォームオーバレイなどで何度も問い合わせました）、ほんとうに感謝です。
なお、ドライバでフォームオーバレイを使用するかしないか、使用するフォームなどを指定するので、運用には注意が必要です。印刷をかけたら関係のないフォームが重ね合わされてしまった、なんてことになります。(^^;

(2014/03/05 追記)
ミロク情報サービス（MJS）のシステムと C811dn の相性がよくないので困ります。MJS のシステムは認定機種という言い方でかなりプリンタを選びます。認定機種でも、例えばキヤノンの機種では「現在 LIPS LX ドライバーでは正しく印刷されない帳票があり」、「必ず LIPS 4 ドライバーをインストールしてください」などの記述がみられます。
こういうアプリケーションは、どこで不具合がでるのかわからないのでとても困ります。
先日は帳票が途中までしか印刷されないという現象がありました。アプリケーションもプリンタもふつうに終わったため、まさかそんなことになっているとは気がつきませんでした（あとでページが足りないことを指摘されてあわてました。オペミスかと思いました）。結局これは C811dn 本体のシステム設定で「タイムアウト印刷」を「オフ」に設定することで解消しました。
こういうことがあると次はなにが起こるか、心配になります。信用にキズがつくこともありえるのですから。

(2014/05/22 追記)
キヤノンのモノクロレーザープリンタ LBP-3800 が故障したので、買い替えることにしました。沖データではモノクロプリンタも 5 年間無償保証・メンテナンス品 5 年間無償提供なので検討対象としたのですが、カラープリンタと違ってモノクロプリンタは保守料等が安いので意外とコストパフォーマンスがよくありません。というわけでキヤノンの機種にしました。

◆閑話休題 (11)◆　Windows 8 Pro をクリーン・インストールしてみる

お客さまのところに Windows 8 の PC が導入されてきているようです。
職員から「USB メモリがお客さまの Windows 8 で使えない」という報告がありました。
私どもでは USB メモリはセキュリティ機能つきのもの(アイ・オー・データの EasyDisk Encryption の初期版)を使用しています。この USB メモリにはパスワード入力で使用可能にするプログラムがあり、それが Windows 8 では正常に動作しないようです。

そろそろ Windows 8 の環境がないと動作検証等で困ることになりそうなので、DELL のノート PC Latitude E5510 に Windows 8 Pro 64 ビット版をインストールしてみました。
Windows 7 では 32 ビット版を選択しましたが、Windows 8 は 64 ビット版を試すことにしました。
その報告を少々・・・・。

OS のインストールはあっけないほど簡単でした。
ただ、デバイス・マネージャをみると「不明なデバイス」が１つあり、無線 LAN のデバイスが「DW1501 Wireless-N WLAN Half-Mini カード」ではなく「Broadcom 802.11n Network Adapter」となっていました。
ところで、デルの E5510 のダウンロードサイトには Windows 8 用のドライバがないのですね。
なので Windows 7 のドライバを入れたのですが、これで無事「不明なデバイス」が消え、無線 LAN も直りました（なお、無線 LAN のドライバは E5510 のものではインストールに失敗したので、「Network_Driver_C9VJ1_WN_A00.exe」というのにしました）。

OS のインストール時にはプロダクトキーの入力がありません。そして、ライセンス認証で「Windows のライセンス認証の手続きを行っている間に問題が発生しました。エラーコード 0x8007007B」となります。
調べてみると、ボリュームライセンスのメディアでインストールしたときにでる現象のようで、MAK 認証にすることで解消しました。コマンドプロンプトで　　　slmgr -ipk xxxxx-xxxxx-xxxxx-xxxxx-xxxxx
とします。詳しくは「エラー 0x8007232b または 0x8007007B が、Windows をライセンス認証しようとすると発生する」(http://support.microsoft.com/kb/929826/ja)を参照してください。

OS のインストール時には組織名の入力がありません。このため、個々のソフトウェアのインストールで組織名を入力しなくてもいいように、レジストリィに登録しました。
「HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\」と
「HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows NT\CurrentVersion\」の
「RegisteredOrganization」です。

そのほか、
道具25「VBScript でデバイスの有効と無効を制御する」の DevCon.exe は 64 ビット版が必要でした。これは http://it.thelibrarie.com/utilities/devcon_x64.zip からダウンロードしました。
道具27「PsExec.exe でクライアントＰＣからサーバーのシャットダウンを指示する」での PsExec.exe は問題なく動作しているようにみえます。
ビジネスセキュリティ 7.0 SP1 にはパッチがでていて、Patch 2(build 2506)をあてました。
WSUS 3.0 SP2 には更新プログラム(KB2734608)をインストールしました。
スタートボタンがなくなったので、フリーソフトの「Start Menu 8」をインストールしました。
デスクトップに「ホームグループ」のアイコンが勝手にできるので毎回 F5 で消すのですが、根本的に表示させない方法はわかっていません。

結局、私どもの環境で Windows 8 に対応していなかったものは JDL のカラープリンタ(LP3630COLOR)のドライバだけでした。
また、うまく動作しないのは msg.exe と Netsh コマンドです。
msg.exe は Windows 8 では「* は存在しないか、切断されています。」となります。
道具19「ネットワークアダプタの TCP/IP のプロパティを設定する」の追記で記載した Netsh コマンドは「要素が見つかりません」というエラーとなります。
いずれも解決していません。

なお、Windows 8 の環境設定（コントロールパネル等）は Windows 7 とそんなにかわらない印象です。

(2013/10/22 追記)
10月18日に Windows 8.1 のアップデートがリリースされましたが、Windows ストアを捜しまわってもみつかりませんでした。どうもボリュームライセンス版ではボリュームライセンスサービスセンター（VLSC）から ISO イメージをダウンロードするようで、Windows ストアには表示されないようです。いちおうアップされていることを確認しましたが様子見です。

◆道具29◆　WORD文書、マクロで宛先を差し込む

初めて WORD でプログラミングをしました。
窓あき封筒に合うようにデザインした文書（書類送付のご案内）に宛先を差し込む、というものです。
文書のデザインはこんな感じ（画像）で、ユーザーフォームもこんな（画像）です。
EXCEL で作った封筒の宛名印刷（画像）というのがあるのですが、簡単な文書だったら窓あき封筒で送られるほうが手間がありません(^^)。

ここのところ面白いことをしていなかったので、気晴らしに挑戦してみました(^^;;。
が、WORD でのマクロは難しい、難しい。
なにが難しいかというと、オブジェクトやなんかが良く分からないことです。
EXCEL ならマクロの記録でなんとかなるのですが、WORD ではこれがうまくいかないのです。
マクロの記録でのコードは Selection オブジェクトだらけで、しかもマクロの記録中はマウス操作が制限されるのですから（<-- マクロの一時停止をするとマウスを使えることが、あとでわかりました）。

宛先を差し込むコードは、次のようになりました。「確定」ボタンが押されたときの処理です。
わかったような、わからないようなコードだと思いませんか？　見かけは簡単そうなのですがね。

   ' 表示を１ページ目のヘッダーに切り替える。宛先と差出人は１ページ目のヘッダーにあるため。
If (ActiveWindow.ActivePane.View.Type = wdNormalView) _
      Or (ActiveWindow.ActivePane.View.Type = wdOutlineView) Then
      ActiveWindow.ActivePane.View.Type = wdPrintView
Else
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageHeader
' １ページ目のヘッダーの表の左側（宛先部分）を消去する｡
Selection.Tables(1).Cell(1, 1).Select
Selection.Delete
' ユーザーフォームの各項目を宛先部分にセットする。
If (Len(txt郵便番号) > 0) Then
      Selection.TypeText Text:="〒" & txt郵便番号
      Selection.Sentences(1).Font.Name = "Verdana"
Else
End If
Selection.TypeParagraph
If (Len(txt住所_上) > 0) Then
      Selection.TypeText Text:=txt住所_上
Else
End If
Selection.TypeParagraph
If (Len(txt住所_下) > 0) Then
      Selection.TypeText Text:=txt住所_下
      Selection.TypeParagraph
Else
End If
Selection.TypeParagraph
If (Len(txt社名) > 0) Then
      Selection.TypeText Text:=txt社名
Else
End If
If (Len(txt氏名) > 0) Then
      Selection.TypeParagraph
      Selection.TypeText Text:=txt氏名
Else
End If
If (Len(cbo敬称) > 0) Then
      Selection.TypeText Text:="　" & cbo敬称
Else
      Selection.TypeText Text:="　様"
End If
' １ページ目のヘッダーの表の右側の１行めに送付日付を設定する｡
Selection.MoveRight Unit:=wdCell, Count:=1
If (Len(txt送付日付) > 0) Then
      Selection.Paragraphs(1).Range.Text = StrConv(txt送付日付, vbWide) & vbCrLf
Else
      If (InStr(Selection.Paragraphs(1).Range.Text, Format(Date, "[$-411]ggg")) > 0) Then
'         １行めに元号があれば、行を消去する。
           Selection.Paragraphs(1).Range.Text = vbCrLf
      Else
      End If
End If
Unload Me
' 表示をメイン文書に切り替える。
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

上記で「１ページ目のヘッダー」というのは WORD の機能です。
蛇足ですが、宛先と差出人部分を１ページ目のヘッダーに置いた理由は、この文書は担当者レベルでいろいろな文書に加工されることを前提としているからです。
担当者にページ設定をどう変更されようとも、ヘッダーなら影響しませんから。また、２ページめにヘッダーはありません。
同じ理由で、この文書は読取り専用の .doc ファイルにしました。テンプレートにはしませんでした。

この文書のマクロは宛先差し込みのほかに２つあります。ついでに紹介しましょう。
この文書には、窓あき封筒にぴったり合うように折り目の目印が左欄外にテキストボックスとして存在しています。
この目印がずれたり、削除されたりしたときに、再設定するマクロがひとつめです。
こんなコードです。

If (ActiveWindow.ActivePane.View.Type = wdNormalView) _
   Or (ActiveWindow.ActivePane.View.Type = wdOutlineView) Then
   ActiveWindow.ActivePane.View.Type = wdPrintView
Else
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

' 目印のテキストボックスを削除する。
If (ActiveDocument.Shapes.Count > 0) Then
   For Each objShape In ActiveDocument.Shapes
      If (objShape.Name = "txt目印") Then
         objShape.Delete
      Else
      End If
   Next
Else
End If

' 新規に目印のテキストボックスを作成する。
ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 22.7, 314, 17#, 17#).Select
Selection.ShapeRange.Name = "txt目印"
With ActiveDocument.Shapes("txt目印")
   .Fill.Visible = msoFalse
   .Line.Visible = msoFalse
   .TextFrame.MarginLeft = 0#
   .TextFrame.MarginRight = 0#
   .TextFrame.MarginTop = 0#
   .TextFrame.MarginBottom = 0#
   .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
   .RelativeVerticalPosition = wdRelativeVerticalPositionPage
   With .TextFrame.TextRange
'    ページ設定に影響されないよう行間を固定にする。
      .ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
      .ParagraphFormat.LineSpacing = 18.45
      .Collapse
      .Text = "−" & vbCrLf
      .ParagraphFormat.Alignment = wdAlignParagraphCenter
   End With
End With

ActiveDocument.Range(Start:=0, End:=0).Select

ふたつめは、ヘッダーの差出人の担当者名を変更するマクロです。姓名のバランスによってはヘッダーの編集が必要ですが、担当者名を差し替えるのにとても便利です。
このユーザーフォームはこんな感じ（画像）の簡単なものです。
「確定」ボタンが押されたときの処理は次のとおりです。

If (ActiveWindow.ActivePane.View.Type = wdNormalView) _
   Or (ActiveWindow.ActivePane.View.Type = wdOutlineView) Then
   ActiveWindow.ActivePane.View.Type = wdPrintView
Else
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageHeader
Selection.Tables(1).Cell(1, 1).Select
Selection.MoveRight Unit:=wdCell, Count:=1

Application.ScreenUpdating = False
With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = cbo変更前
   .Replacement.Text = cbo変更後
   .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True

If (chkヘッダー編集 = True) Then
Else
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End If
Unload Me

今回の経験で、WORD のマクロはもう結構、という感じですね。まあ、ほかに何のアイデアもないのですけど(^^;;。

◆閑話休題 (10)◆　EXCEL 2010 の 2003 との互換性

EXCEL 2010 で 2003 とファイルの互換をとるには、EXCEL 2010 のファイルの保存形式（オプション）で「Excel 97-2003 ブック(*.xls)」とします。
EXCEL 2003 に互換機能パックを適用して 2010 の形式で互換をとるよりも安心な(?)気がします。
ただ、EXCEL 2010 で 2003 のファイルを保存するとき、何もしてなくても互換性チェックにひっかかるのが、とても不便です。
EXCEL 2010 で何も変更していないにもかかわらず、例えば「機能の大幅な損失」として「このブック内の一部のセルには、他のワークシートの値を参照するデータ入力規則が設定されています。これらのデータ入力規則は、以前のバージョンの Excel ではサポートされません。」と怒られます。<--「Excel 2010 にて保存時に「他のワークシートの値を参照するデータ入力規則」に関する [互換性チェック] のダイアログが誤って表示される場合がある」(http://support.microsoft.com/kb/2600375/ja)を参照のこと。
この場合「このブックを保存するときに互換性を確認する」のチェックをはずして「続行」するのですが、とても面倒です。
VBA の処理でも同じで、保存のときに互換性チェックのダイアログが表示され、「続行」を選択しないとコケてしまいます。
そこで、互換性チェックは Workbook オブジェクトの CheckCompatibility プロパティなので、必要に応じて保存の前に False にするコードを追加したり、まとめて False にするバッチ処理を作成して対応しました。
互換性チェックの詳細は「以前のバージョンの Excel で Office Excel 2010 ファイルを使用する」(http://office.microsoft.com/ja-jp/excel-help/HA010342994.aspx)を参照してください。

EXCEL 2010 で 2003 と操作上の互換をとるため、「クラシックスタイルメニュー for Office 2010」アドインをインストールしました。便利です。

EXCEL 2010 で 2003 とパレットの互換をとるため、「Excel 2003 カラーパレット・改」アドインをインストールしました。これも便利です。

マクロの互換性については「Microsoft Office 2010 マクロ互換性について」(http://download.microsoft.com/download/6/C/F/6CF568B6-F788-4FA0-AA76-88A5AE83B671/Office2010_compatibility_for_macro.pdf)を参照してください。
これを読んでもよく分からないので、不具合がでたときに対応することにします。
今のところ Workbooks.Open で存在しない FileName を開こうとしたとき、エラートラップの前にダイアログが表示されるようになったのを修正しただけで済んでいます。
これには Workbooks.Open の前に Application.DisplayAlerts = False の１行を追加しました。

EXCEL 2003 で作成した独自のツールバーは、2010 ではリボンの「アドイン」タブに表示されるので、互換に問題ありません。

独自のツールバーをリボンの「アドイン」タブではなく、ほんらいのリボンとするにはアドインとして実装します。
リボンのデザインは「Office Ribbon Editor」を使用して Open XML 形式で定義し、コマンドのアイコンは「Office 2010 Icon Viewer.xlsm」で選べば簡単に(?)作成できます。
例えば、「ほげほげ」ボタンの Open XML 形式の定義は次のようにします。

     <button id="btnHogeHoge" label="ほげほげ" imageMso="CreateReportBlankReport" size="large" onAction="ps_HogeHoge" />

ボタンを押されたときの処理はアドインの標準モジュールに置きます。元のブックにある該当のプロシージャを起動するだけの簡単なコードを書きます。

     Public Sub ps_HogeHoge(control As IRibbonControl)
          If (ActiveWorkbook.Name = "ほげほげ.xls") Then
               Application.Run ("ほげほげ.xls!ps_HogeHoge")
          Else
          End If
     End Sub

とはいうものの、独自のツールバーをリボンに移行する場合、実装方法の違いによりコードの大幅な修正が必要になることがあります。
EXCEL 2003 では CommandBar オブジェクトを使用します。このため、Visible プロパティで場面に応じたボタンだけ表示したり、ボタンの Caption プロパティで「ON」の表示のとき押されたら「OFF」と表示したりするのも簡単で、実際に実装しています。
このような処理をリボンの Open XML 形式で実装するにはかなりの無理があるといえます。
リボンの「アドイン」タブで使用するなら、このへんの互換もとれているので、無理して移行することもないか、と考えています。見栄えはいまいちですが。(^^;

◆閑話休題 (9)◆　Sysprep でイメージ展開するとログオフに時間がかかる

Windows XP と Office 2003 の延長サポートが平成26年4月9日で終了するので、いよいよ Windows 7 と Office 2010 に移行することにしました。

Windows 7 をイメージ展開するには Sysprep を使用します。
Sysprep ではカスタマイズしたデフォルトユーザープロファイルを作成することもできます。
このため、原本となる環境ではユーザー Administrator だけを残し、Administrator のプロファイルをカスタマイズします。

試行錯誤した結果、最終的な応答ファイルは次のようなものとなりました。

1 windowsPE
x86_Microsoft-Windows-Setup_neutral
  [UserData] AcceptEuia   true

3 generalize
x86_Microsoft-Windows-PnpSysprep_neutral
   DoNotCleanUpNonPresentDevices   true ････(a)
   PersistAllDeviceInstalls   true ････(a)
x86_Microsoft-Windows-Security-SPP_neutral
   SkipRearm   1

4 specialize
x86_Microsoft-Windows-IE-InternetExplorer_neutral ････(b)
   AllSitesCompatibilityMode   true
   DisableAccelerators   true
   DisableFirstRunWizard   true
   DisableOOBAccelerators   true
   DisableWelcomePage   true
   EnableLinksBar   false
   FavoritesDelete   true
   Home_Page   http://www.hogehoge.co.jp/
   IEWelcomeMsg   true
   ShowMenuBar   true
x86_Microsoft-Windows-Shell-Setup_neutral
   CopyProfile   true ････(c)
   DoNotCleanTaskBar   true
   ProductKey   xxxxx-xxxxx-xxxxx-xxxxx-xxxxx
   RegisteredOrganization   organization
   RegisteredOwner   owner
   TimeZone   Tokyo Standard Time
  [AutoLogon] Enabled   true ････(d)
                     Username   hoge
                    [Password] Value   password
x86_Microsoft-Windows-UnattendedJoin_neutral
  [Identification] JoinWorkgroup   WORKGROUP

7 oobesystem
x86_Microsoft-Windows-International-Core_neutral
   InputLocale   0411:E0200411 ････(e)
   SystemLocale   ja-JP
   UILanguage   ja-JP
   UILanguageFallback   ja-JP
   UserLocale   ja-JP
x86_Microsoft-Windows-Shell-Setup_neutral
  [OOBE] HideEULAPage   true
              NetworkLocation   Work
              ProtectYourPC   1
  [TaskbarLinks] Link0   %ALLUSERSPROFILE%\Microsoft\Windows\Start Menu\Programs\Mozilla Thunderbird.lnk ････(f)
  [FirstLogonCommands] SynchronousCommand CommandLine   C:\PcFirstSetup.bat ････(g)
  [UserAccounts][LocalAccounts] DisplayName   hoge ････(h)
                                               Group   Administrators
                                               Name   hoge
                                             [Password] Value   password
                        [LocalAccounts] DisplayName   hogehoge
                                               Group   Administrators
                                               Name   hogehoge
                                             [Password] Value   password

応答ファイルのリファレンスはこちら(http://technet.microsoft.com/en-us/library/ff699026.aspx)を参照してください。

ちょっと補足すると、
(a) のふたつはデバイスドライバを残す設定です。同一機種でイメージ展開するので true としました。
(b) は Internet Explorer の設定です。
(c) は原本の Administrator のプロファイルをデフォルトユーザープロファイルにコピーする指定です。
(d) はユーザー hoge でオートログオンさせる設定です。(h) でユーザー hoge を作成しています。
(e) は IME に IME 2010 を指定する設定です。こちら(http://remarque.blog50.fc2.com/blog-entry-117.html)を参考にしています。
(f) は Thunderbird を標準のメールソフトとしたので、タスクバーに Thunderbird をピン留めする設定です。Internet Explorer と Windows Media Player は無条件に新規でピン留めされます。原本となる環境では、これらもタスクバーから削除して何もピン留めしてない状態にしておきましょう。
(g) は Sysprep 中にバッチコマンド(PcFirstSetup.bat)を実行する指定します。Sysprep 中に任意のコマンドを実行する方法についてはこちら(http://blogs.technet.com/b/askcorejp/archive/2010/05/28/sysprep.aspx)を参考にしています。
この PcFirstSetup.bat では、ユーザー Administrator のアカウントを有効にし、(h) で作成しているユーザー hoge と hogehoge のパスワードを「ユーザーが変更できないように」すると同時に「無期限に」しています。
     Net User Administrator /active:yes
     wmic.exe useraccount where (Name = "hoge") set PasswordChangeable = false
     wmic.exe useraccount where (Name = "hoge") set PasswordExpires = false
     wmic.exe useraccount where (Name = "hogehoge") set PasswordChangeable = false
     wmic.exe useraccount where (Name = "hogehoge") set PasswordExpires = false

で、話はここからです。
ここまでは順調だったのですが、実際に Sysprep を実行してイメージを展開すると、思わぬトラブルに見舞われました。ログオフが異常に遅いのです。
シャットダウンを指示して「ログオフしています」で４〜５分もかかるのでは、業務にはとても使えません。

もちろん原本の環境ではなんの問題もありません。イメージ展開した環境だと発生するのです。
イベントログにはイベント ID 6005 の「winlogon 通知サブスクライバー <Sens> で通知イベント (Logoff) を処理するのに長い時間がかかっています」という警告が残っていますが、ほかに参考となりそうなイベントは見あたりません。
ネットで検索しても Sysprep がらみのこのような現象はどこにも報告されていません。

応答ファイルを変更したり、原本の環境を最初からインストールしなおしてみたりしたのですが、なんの効果もありませんでした。これらの作業にはとんでもなく時間がかかってしまって、泣けました。

結局、Sysprep でつくった環境の検証作業をしているうちに対症療法がわかりました。ワークグループ環境からドメイン環境に移行すれば解消するのです。その後はワークグループ環境に戻っても現象はでなくなります。

(2013/05/16 追記)
上記の現象は DELL のノート PC Latitude E5510 でのことでした。どのノートでもまったく同じ現象がでます。
ところが、EPSON DIRECT のデスクトップ PC の MR3500 で Sysprep したところ、不思議なことにこの現象がでませんでした。~~原本の環境や応答ファイルが多少違うのですが、どのへんが影響しているのかは時間がないため調べられないでいます。~~
別の MR3500 では現象がでたので、またまた訳がわかりません。

(2013/05/20 追記)
イメージ展開後、WSUS とウイルスバスター Biz で似たような現象がでました。Sysprep では ID が再生成されないので原本の ID がそのまま残り、重複して不具合がでるようです。
WSUS については「［コンピュータ］にクライアントPCが表示されない（その2）」(http://www.atmarkit.co.jp/fwin2k/operation/wsusqa01/wsusqa01_03.html)の方法で解消します。
ウイルスバスター Biz では 7.0 から ClientID を再生成するツールが付属されたそうで、管理者ガイドの214ページに ReGenID ツールというものが載っています。ただし、これは仮想環境での重複を想定したもので、イメージ展開による重複は動作検証外なので自己責任で、とのことでした。

(2013/08/29 追記)
記載するのを忘れましたが、Windows 7 は 32 ビット版をインストールしました。閑話休題(11) では Windows 8 の 64 ビット版のインストールをとりあげました。

(2013/10/22 追記)
デスクトップ PC の MR3500 で Sysprep のイメージ展開をしたところ「このコンピューターのハードウェアで動作するように Windows を構成できませんでした」というエラーになって先に進みません。
実はこのときハードディスクを Western Digital の WD10EZEX に換装していたのでした。
とりあえず BIOS の SATA Configuration を「AHCI」から「Standard IDE」に変更すると Sysprep できることを確認しました。
調べてみると最近の HDD は Advanced Format Technology（AFT）というのを採用していて、これが影響しているようです。
BIOS は「AHCI」のままにしたいので、元の HDD で Sysprep して、そのあとで新しい HDD にイメージをクローンすることにしました。
これで無事使えるようになりました。
ところがすぐに次のトラブルです。Windows Update ができないのです。これも AFT がらみのようです。
EPSON DIRECT の MR3500 の Windows 7 ドライバサイトに Intel Matrix Storage Manager がアップされているので当然インストールしたわけですが、これが AFT に対応していないために起こる現象のようです。
これをアンインストールして Intel Rapid Storage Technology をインストールすれば問題解消です(^^)。
これらのトラブルは、ウェブで検索するとたくさんみつかるのでたすかりました（Windows Update サポートチームの[C8000247] 「現在サービスが実行されていないため〜」のエラーについて(http://blogs.technet.com/b/wuj/archive/2013/07/26/c8000247.aspx)など）。
なお、WD10EZEX は外観からは AFT かどうかはわかりません。
また、CrystalDiskMark でチェックすると前の HDD より断然速いのでちょっとうれしいです。実感ないですが・・・(^^;;。

(2013/11/01 追記)
Sysprep で試行錯誤したりなんだりで、Windows 7 の MAK のライセンス数が上限に近づいてきました。
そこで、ボリュームライセンスサービスセンター（VLSC）にある「MAK / KMS 認証上限数変更申請フォーム」で増やしてもらうことにしました。
「申請受領後、3 営業日のお時間をいただいております」とのことですが、翌日には完了メールが届き、無事変更してもらえました。
うるさい手続きが必要なのかと思っていましたので、ちょっと拍子抜け(?)しました。
これで、Windows 8 の PC を Windows 7 にダウングレードするときも安心です。まだ先の話ですが・・・(^^)。

◆道具28◆　サイトに最新のドライバがないかチェックする

デルのサーバー PowerEdge 840 の５年の保守が切れました。早いです。
というわけで今回 PowerEdge T320 を購入しました。現在テスト稼働中です。速いです。

設定作業中にデルのドライバダウンロードサイトで、システム管理に「Server Update Utility ISO」というのがあったので試してみました。
DVD に焼いて利用します。蛇足ですが、Windows Server 2008 R2 で iso イメージを DVD に焼くには、デスクトップエクスペリエンスを機能追加します。
Server Update Utility は、最新のドライバがインストールされているかチェックしたり、インストールの指示ができます。まとめてアップデートできるのでとても便利です。
もう１台の PowerEdge T310 と共通に使えるということも、めんどうがなくてよいのです。
現在のバージョンが 7.1.0 なので、前からあったのですね。知らなかった････。

デルのドライバダウンロードサイトにはドライバのバージョンがあがった場合にメールで通知してくれるサービスがあります。ご存知でしたか？
ところが、この「Server Update Utility ISO」にはその設定ができないようです。
しかたがないので「Server Update Utility ISO」がバージョンアップされているかチェックするスクリプトを作りました。

     Const c_strUrl = "http://www.dell.com/support/drivers/jp/ja/jpbsd1/Product/poweredge-t320?s=bsd"
     Const c_strSUU = "DriverId=1JNR5"

     ' テキストの取得
     Set objHTTP = CreateObject("MSXML2.XMLHTTP")
     Call objHTTP.Open("GET", c_strUrl, FALSE)
     On Error Resume Next
     objHTTP.Send
     If (Err.Number = 0) Then
     Else
          Err.Clear
          Call ps_SendMail
          Wscript.Quit
     End If
     On Error Goto 0
     strText = objHTTP.ResponseText
     Set objHTTP = Nothing
   If (InStr(1, LCase(strText), LCase(c_strSUU)) > 0) Then
     Else
          Call ps_SendMail
     End If

     'メール通知
     Private Sub ps_SendMail
　　     　　　省略。閑話休題 (5)をみてください。
     End Sub

ダウンロードサイトが変わったり、バージョンを特定する文字列が見つからなかったらメール通知するというものです。
道具16とおなじように Web ページのコンテンツを取得する方法を知っていれば簡単ですね。
これを定期的に実行するようにスケジュールしましょう。
ちゃんとメールがくるか、バージョンアップがたのしみです(^^)。
バージヨンアップがあったら定数を修正するのを忘れずに。

しかし、ネタがなくなって焼きなおしのような話題なのが、いささか････。

(2012/10/30 追記)
「Server Update Utility ISO」の 7.1.1 が10月19日にリリースされ、タイミングよく動作検証できました。
ちょっと手直しが必要でした。上記のコードは修正後です(^^)。
要はどこの URL をみて、どの文字列を検索するかだけの問題です。こんどはうまくいくでしょうか？

(2012/11/08 追記)
今回、サーバー３台を RAID 構成の手直しからすべて再構築しました。たいへんでした。
これでサーバーはすべて Windows Server 2008 R2 になりました。
今まで Windows Server 2008 R2 では、右クリックなどでの「個人設定」ができないものと思いこんでいましたが、デスクトップエクスペリエンスを機能追加すればできるようになることを知りました。

◆閑話休題 (8)◆　POP before SMTP のためにメールが送れないので・・・・

閑話休題(5)で CDO（Collaboration Data Objects）によるメール送信について話題にしました。
これが便利なので、サーバーのスクリプトからの通知を自分のケータイにメールするようにしています。
ところが、最初は気のせいかと思っていましたが、メールが送られないタイミングがあるようなのです。

道具27の「PsExec.exe でクライアントＰＣからサーバーのシャットダウンを指示する」で話題にしたサーバのバックアップとシャットダウンのスクリプトを実行するようになって顕在化しました。
サーバーがバックアップを終了してシャットダウンするときに「シャットダウン実行」というメールを送信するのですが、これがほとんど届きません。
調べてみれば CDO の Send メソッドで「553 sorry, that domain isn't in my list of allowed rcpthosts (#5.7.1)」というエラーになっています。
そう、POP before SMTP によるエラーです。

POP before SMTP　はメール送信の前にメールを受信することでセキュリティを確保する仕組みです。
私どもでは、原則としてネット専用のデスクトップＰＣでメールの送受信やインターネットを見ることにしています。
このため、ネット専用のＰＣでは Outlook Express が５分毎に新着メッセージをチェックしています。
ということで、ネット専用のＰＣで Outlook Express が起動しているときは問題なかったわけです。
ネット専用のＰＣは昼休みや終業時には電源を切ります。また、誤って Outlook Express を終了させてしまうこともあります。
そんなとき（最後のメール受信から一定時間後）にメール送信ができなかったわけですね。なっとく、なっとく。

で、どうしましょう？

最初はサーバーで Outlook Express を起動することを考えました。
しかし、サーバーが自動ログオンして Outlook Express を起動するというのは気が進みません。

そこで BASP21.DLL を使用してメール受信する次のようなスクリプトを作成しました。(実に簡単！^^)
これを５分毎に実行するようにスケジュールすれば良いのです。
スクリプト内にユーザ名（アカウント名）とパスワードを記述することによるリスクはあるのですが････。

     ' POP before SMTP のためにメールを受信する
     ' （タスクスケジューラで５分間隔で実行するように登録）
     Const c_strPop3Server = "pop3.iwatax.jp"
     Const c_strUserID = "hoge00010"
     Const c_strPassWord = "HogePW"
     Const c_strCommand = "SAVEALL"
     Const c_strRecvDir = "C:\Temp"
     Dim objBASP21
     Dim varMail

     Set objBASP21 = CreateObject("basp21")
     varMail = objBASP21.RcvMail(c_strPop3Server, _
                                                c_strUserID, _
                                                c_strPassWord, _
                                                c_strCommand, _
                                                c_strRecvDir)
     Set objBASP21 = Nothing

このアカウントは送信専用にします。そうすれば受信フォルダを気にすることもありません（常に空っぽ）。
なお、Windows Server 2008 R2 などの64ビットＯＳの場合は BASP21 が C:\Windows\SysWOW64 にインストールされるため、タスクスケジューラのプログラムの指定は C:\Windows\SysWOW64\Wscript.exe とし、引数にスクリプトのパスを指定します。
ふつうにスクリプトを起動すると「ActiveX コンポーネントはオブジェクトを作成できません。:'basp21'」とおこられてしまいます。このメッセージで「ああ、そうそう」と思いだすのです。

◆閑話休題 (7)◆　Windows の設定はたいへんです

道具27の「PsExec.exe でクライアントＰＣからサーバーのシャットダウンを指示する」では正しく機能させるまでにたいへんな思いをしたので、その報告を。

まず、PsExec.exe では「アクセスが拒否されました。」となりました。
これにはファイアウォール以外に３つの原因がありました。

ひとつは、ドメイン環境にあるサーバーにワークグループ環境のＰＣから PsExec.exe を起動したことによるものです。
まぬけです、ワークグループのＰＣにそのアカウントを登録しなかったためでした。
今回 Msg.exe で「ターミナルサーバーＰＣ名を開けませんでした。エラー [5]:アクセスが拒否されました」となるのも同じ理由でした。
ただし、PsExec.exe の場合はそれだけでなく、このローカル・アカウントにも管理者権限がないと「アクセス拒否」になるのです（ドメインのアカウントにはバックアップする関係で管理者権限がある）。

ふたつめは、ひとつめと同じドメインのサーバーにワークグループのＰＣから PsExec.exe を起動したことによるもので、「Active Directry ユーザーとコンピュータ」でワークグループのＰＣをADのコンピュータ・オブジェクトに登録することで解決しました。
ワークグループのＰＣからドメインのファイルサーバーやデータベースサーバーを利用するのに特別な設定は必要ないため、なかなか気がつきませんでした。ADのコンピュータ・オブジェクトに登録することにどのような意味があるのかわかりませんが、結果オーライということで^^;。

最後にわかったのが、クライアントＰＣにネットワークドライブを設定してあると「アクセス拒否」の原因になるということです。
Administrator でログオンするとネットワークドライブを設定してあっても動作するのですが、ほかのアカウントの場合は管理者権限があっても「アクセス拒否」になります。
なにか根本的な原因と解決方法があるのかもしれませんが、わからないのでネットワークドライブを切断することで対処しました。
次のようなコードを PsExec でシャットダウンを指示する前後に入れます。

     ' 既定のネットワークドライブ(X:)があるかチェックする
     strDriveX = ""
     Set objWshNetwork = CreateObject("Wscript.Network")
     Set objNetworkDrives = objWshNetwork.EnumNetworkDrives
     For lngIndex = 0 To objNetworkDrives.Count - 1 Step 2
          If (UCase(objNetworkDrives.Item(lngIndex)) = "X:") Then
               strDriveX = objNetworkDrives.Item(lngIndex + 1)
          Else
          End If
     Next
     Set objWshNetwork = Nothing
     ' リソース共有をすべて解除する
     Set objShell = CreateObject ("WSCript.shell")
     strRunString = "cmd.exe /c net use * /delete /yes"
     objShell.Run strRunString, 7, True

          （PsExec でシャットダウンを指示するコード）

     ' 既定のネットワークドライブ(X)を復元する
     If (strDriveX = "") Then
     Else
          strRunString = "cmd.exe /c net use X: " & strDriveX & " /PERSISTENT:YES"
          objShell.Run strRunString, 7, False
     End If

PsExec.exe で「アクセス拒否」に関しては以上のとおりですが、PsExec.exe で「アクセス拒否」となる現象と同時に、実際にバックアップする独自のスクリプトでも問題をかかえていました。
スクリプト中の Xcopy でコケるのです。

この現象は Windows Server 2003 R2 では発生せず、Windows Server 2008 R2 で発生します。
また、Administrator なら発生せず、新しく作成したアカウント（管理者権限あり）であると発生します。
このふたつのヒントでわかる人にはわかるのでしょうね？

Windows Server 2008 R2 のサーバーで新しく作成したアカウントでログオンし、コマンドプロンプトから Xcopy コマンドをためしてみると「アクセスは拒否されました」となります。
ファイルとフォルダーのアクセス権がないような感じなのですが、管理者権限があるアカウントなのでそんなはずがありません。
じたばたと、フォルダーのアクセス権限をいじってみましたが、やはり状況はかわりません。
Administrator でなんの問題がないことは当然として、管理者権限があるアカウントで同じようにならないのはなぜなのでしょう？

ためしにエクスプローラーを使ってフォルダーのコピーをしてみました。
すると思いがけず「対象のフォルダーへのアクセスは拒否されました　このフォルダーへコピーするには管理者のアクセス許可を提供する必要があります」というダイアログが表示されました。
ふだん Windows XP なのでまったく頭にうかびませんでしたが、Windows Vista 以降ではこのような表示がされることを思いだしました。
ユーザーアカウント制御(UAC)ですね。
管理者権限があるアカウントでもこんなのがでるなんて････しらなかった。

というわけで、これをださない方法をさがしたら、ありましたありました。
Windows Server 2008 R2 のローカルセキュリティポリシーの、セキュリティの設定 − ローカルポリシー − セキュリティオプションで
「ユーザーアカウント制御：管理者承認モードですべての管理者を実行する」を「無効」にすればよいのでした（既定は「有効」）。

わかってみればいずれも簡単な話(?)なのですが、解決までの道のりは遠くて険しかった。
いつにもまして「Windows の設定はたいへんだ」とつくづく思ったしだいです。

(2012/05/12 追記)
このコラムを書いたあと @IT の Windows TIPS に「リモート・コンピュータ上でプログラムを実行する（PsExec編）」(http://www.atmarkit.co.jp/fwin2k/win2ktips/1416psexec/psexec.html)という記事を見つけました。これにずいぶんヒントがありました。
解決してから見つかるとはなんともヒニクなものです。マーフィーの法則ですね。(^^;;

(2012/05/22 追記)
最初 PsExec.exe に -i オプションをつけて起動していましたが、Windows Server 2008 R2 でログオンしていない状態ではバックアップの独自スクリプトが途中でフリーズ(?)するような現象があったため（Windows Server 2003 R2 では発生しない）、-i オプションをとりました。そもそも -i オプションの意味もよくわからないのでお恥ずかしいのですが････。

(2012/08/28 追記)
PsExec.exe でアクセス拒否（？）になる原因がまだあるようで、たまに PsExec.exe による指示が無視されます。少し時間をおいて再度指示をおこなうと今度はうまくいきます。
お手上げ状態なので、バックアップとシャットダウンの指示がうまくいかなかったときのために、午後10時にスクリプトを起動するようにスケシ゜ュールすることにしました。
このような運用にするとスクリプトの重複起動（PsExec.exe で起動されたスクリプトが終了する前に、タスクスケジューラで起動される可能性があります）が避けられませんから、サーバー側で走らせるスクリプト BackupAndShutdown.vbs には重複起動をチェックするコードを追加します。
スクリプトが起動されたら、ファイル C:\Temp\Running_BackupAndShutdown が存在するかどうかで重複起動を判定します。

     Const c_strFileName = "C:\Temp\Running_BackupAndShutdown"

     Set objFSO = CreateObject("Scripting.FileSystemObject")
     If (objFSO.FileExists(c_strFileName) = True) Then
     '    すでに起動されているので終了する
          Set objFSO = Nothing
          Wscript.Quit
     Else
     '   ファイルの新規作成（空データ）
          Set objTextF = objFSO.CreateTextFile(c_strFileName, True)
          objTextF.Close
          Set objTextF = Nothing
     End If
     Set objFSO = Nothing

そして、スクリプトの終了時にはこのファイルを削除します。

     Set objFSO = CreateObject("Scripting.FileSystemObject")
     objFSO.DeleteFile c_strFileName, True
     Set objFSO = Nothing

(2012/10/16 追記)
PsExec.exe に -e オプションをつけると、ちょっといいことがあるような････(^^)。

◆道具27◆　PsExec.exe でクライアントＰＣからサーバーのシャットダウンを指示する

サーバー３台をシャットダウンするのは意外とめんどうです。
また、シャットダウンのタイミングでデータのバックアップができたらいいな、とも思っていました。
最近になって PsExec.exe というツールがあることを知りました。
これはリモートコンピュータにあるプログラムをキックできるというたいへん便利な（たいへん危険な）ツールなのです。

これを使えばサーバー３台のシャットダウンを簡単に指示できそうです。ちょっと試してみることにしました。

まず、クライアントＰＣのスクリプトです。
Ping をうって応答があったサーバーを対象にします。
PsExec.exe は %Windir% に置きます。
サーバー側で走らせるスクリプトは BackupAndShutdown.vbs（後述）で、引数として「指示したＰＣ名」と「バックアップをするかしないか」を渡します。
PsExec.exe にはユーザー名とパスワードが必要ですが、すこしでもリスクを軽減するようにこのジョブ用に新たにアカウントを作成し、パスワードは都度入力します。
このスクリプトはクライアントＰＣだけでなく、サーバー自身でも実行可能とします。

     strPrompt = "シャットダウンと同時にバックアップをしますか？" & vbCrLf & vbCrLf _
                    & "（キャンセルは処理中止）"
     lngResult = Msgbox(strPrompt, vbYesNoCancel, "サーバーのシャットダウン")
     If (lngResult = vbYes) Then
          strBackup = "する"
     Else
          If (lngResult = vbNo) Then
               strBackup = "しない"
          Else
               Wscript.Quit
          End If
     End If

     strShutdown1 = ""
     strShutdown2 = ""
     strShutdown3 = ""
     Set objWMIService = GetObject("winmgmts:\\.")
     ' ServerHoge1 の確認
     Set objPingCollection = objWMIService.ExecQuery _
               ("Select * from Win32_PingStatus Where Address = 'ServerHoge1'")
     For Each objPing in objPingCollection
          If (objPing.StatusCode = 0) Then
               strPingStatus = "OK"
          Else
               strPingStatus = "NG"
          End If
     Next
     If (strPingStatus = "OK") Then
          strPrompt = "ServerHoge1 をシャットダウンしますか？" & vbCrLf & vbCrLf _
                         & "（キャンセルは処理中止）"
          lngResult = Msgbox(strPrompt, vbYesNoCancel, "サーバーのシャットダウン")
          If (lngResult = vbYes) Then
               strShutdown1 = "する"
          Else
               If (lngResult = vbNo) Then
                    strShutdown1 = "しない"
               Else
                    Wscript.Quit
               End If
          End If
     Else
     End If

               （ServerHoge2 と ServerHoge3 に対しても上記とおなじように確認をします）

     Set objPing = Nothing
     Set objPingCollection = Nothing
     Set objWMIService = Nothing

     If (strShutdown1 = "する") _
          Or (strShutdown2 = "する") _
          Or (strShutdown3 = "する") Then
     Else
          strPrompt = "シャットダウンするサーバーはありませんでした。"
          Msgbox strPrompt, vbOkOnly, "サーバーのシャットダウン"
          Wscript.Quit
     End If
     ' 最終確認とパスワードの入力をさせる
     strPrompt = "ほんとうに実行するなら" & vbCrLf & vbCrLf _
                    & "パスワードを入力してください"
     If (strBackup = "する") Then
          strPrompt = strPrompt & vbCrLf & vbCrLf _
                         & "【注意】バックアップには１時間程度かかります。"
     Else
     End If
     strPrompt = strPrompt & vbCrLf
     strPassword = InputBox(strPrompt, c_strTitle)
     If (strPassword <> "") Then
     Else
          strPrompt = "シャットダウンをキャンセルしました。"
          Msgbox strPrompt, vbOkOnly, c_strTitle
          Wscript.Quit
     End If

     ' ＰＣ名を取得する
     Set objWshNetwork = CreateObject("Wscript.Network")
     strPcName = LCase(objWshNetwork.ComputerName)
     Set objWshNetwork = Nothing

     ' PsExec でサーバーに対してシャットダウンを指示する
     Set objShell = CreateObject ("WSCript.shell")
     If (strShutdown1 = "する") Then
          strRunString = "%Windir%\PsExec.exe "
          If (strPcName = LCase("ServerHoge1")) Then
          Else
               strRunString = strRunString & "\\ServerHoge1"
          End If
          strRunString = strRunString & " -d -u hogehoge.local\USERNAME -p " & strPassword _
                              & " Wscript.exe C:\BackupAndShutdown.vbs " _
                              & strPcName & " " & strBackup
          objShell.Run strRunString, 7, False
     Else
     End If

               （ServerHoge2 と ServerHoge3 に対しても上記とおなじように指示をします）

     Set objShell = Nothing

上記スクリプトでは WMI（Win32_PingStatus）により Ping をうっていますが、スクリプトセンターの「ping を使用するスクリプトを Windows 2000 コンピュータで実行できないのはなぜですか
」(http://gallery.technet.microsoft.com/scriptcenter/c576a778-9f0b-4ee4-8390-68607adb51bb)で、別の方法が紹介されています。
（まったく関係ありませんが、わたしんちのイヌの通称は「ピン」（画像）です）。

では次に、サーバー側で走らせるスクリプト BackupAndShutdown.vbs ですが、こんな感じです。
引数として「指示したＰＣ名」と「バックアップするかしないか」を受け取ります。
指示したＰＣには msg.exe で起動したことを通知します。
バックアップには独自のスクリプト BackupServerHogeX.vbs を使用します。
シャットダウンには Shutdown.exe を使用します。
また、サーバー３台で共通のスクリプトにします。

     If (WScript.Arguments.Count = 2) Then
          strRemotePcName = WScript.Arguments.Item(0)
          strBackup = WScript.Arguments.Item(1)
     Else
          Wscript.Quit
     End If

     ' ＰＣ名を取得する
     Set objWshNetwork = Wscript.CreateObject("Wscript.Network")
     strPcName = LCase(objWshNetwork.ComputerName)
     Set objWshNetwork = Nothing

     ' 呼び出したＰＣに起動を通知する
     strRunString = "cmd.exe /c msg.exe * /server:" & strRemotePcName _
                         & " " & strPcName
     If (strBackup = "する") Then
          strRunString = strRunString & " はバックアップとシャットダウンを開始しました。"
     Else
          strRunString = strRunString & " はシャットダウンを開始しました。"
     End If
     Set objShell = WScript.CreateObject ("WScript.shell")
     objShell.Run strRunString, 7, False

     ' バックアップのスクリプトを起動する（終了まで待機する）
     If (strBackup = "する") Then
          If (strPcName = LCase("ServerHoge1")) Then
               strRunString = "WScript.exe C:\BackupServerHoge1.vbs"
               objShell.Run strRunString, 7, True
          Else
          End If
          If (strPcName = LCase("ServerHoge2")) Then
               strRunString = "WScript.exe C:\BackupServerHoge2.vbs"
               objShell.Run strRunString, 7, True
          Else
          End If
          If (strPcName = LCase("ServerHoge3")) Then
               strRunString = "WScript.exe C:\BackupServerHoge3.vbs"
               objShell.Run strRunString, 7, True
          Else
          End If
     Else
     End If

     ' シャットダウンする
     strRunString = "Shutdown.exe -s"
     objShell.Run strRunString, 7, False
     Set objShell = Nothing

入力されたパスワードが正しいかどうかを確認したいのですが、その方法がわからないのでサーバーから起動のメッセージが届くかどうかで判断します。
また、環境によっては PsExec.exe や msg.exe で「アクセス拒否」などが発生することがあります。うまく動作しないときはコマンドプロンプトで確認してみましょう。

◆閑話休題 (6)◆　VBScript で引数を受け取る

VBScript ではコマンドラインの引数は Arguments コレクションにより受け取ることができます。
引数は配列で受け取ります。引数が省略されても問題がないようにコーディングしましょう。

     For Each objArgument In WScript.Arguments
          Msgbox objArgument
     Next

配列を直接操作したほうがわかりやすいような気がします。

     If (WScript.Arguments.Count = 2) Then
          Msgbox WScript.Arguments.Item(0)
          Msgbox WScript.Arguments.Item(1)
     Else
     End If

コマンドラインでは半角スペースで引数を区切ります。カンマ(,)ではないのですね。
ひとつの引数に半角スペースを含める場合は引用符(")で囲みます。

     C:\> C:\hogehoge.vbs A B C "a b c"

タスクスケジューラでスクリプトに引数を渡すときは注意が必要です。
引数がなければ「実行するファイル名」にはスクリプトのパスを指定すればよいのですが、引数がある場合は「実行するファイル名」に wscript.exe を入れなければなりません。

     wscript.exe C:\hogehoge.vbs A B C "a b c"

wscript.exe を指定せずにスクリプトのパスと引数だけでは引数が無視されてしまいます。

◆閑話休題 (5)◆　CDO for Windows 2000（cdosys.dll）と SMTP

節電と経費節減について物思う今日このごろです。
ということで、外出している職員との連絡に電話をかけているのですが、これをメールにすることにしました。

Windows には手軽にメール送信ができる CDO（Collaboration Data Objects）というコンポーネント（cdosys.dll）があります。
次のスクリプトで簡単にメール送信ができることが確認できます。

     Set objCdoMessage = CreateObject("CDO.Message")
     With objCdoMessage
          .From = "hogehoge@iwatax.jp"
          .To = "iwata-tsukusu@docomo.jp"
          .Subject = "Test"
          .TextBody = "テストですよ。"
          .Send
     End With
     Set objCdoMessage = Nothing

データベース（SQL Server）のフロントエンドとして EXCEL を使った「職員予定表」システムがあるので、これに機能追加しました。
こんな感じの画面（画像）です。

で、本題はここからです。

パイロット版が完成したので、メール通知機能を職員用のノートＰＣでテストしてみることにしました。
ところが、管理者用のＰＣ（開発マシン）では問題なく動くのに、職員用ＰＣでは動かないのです。
職員用ＰＣでは Send メソッドのところで VBA の実行時エラーになります。
なぜなのでしょう？

とりあえず、権限とファイアウォールについて確認しましたが、どちらも無関係のようです。
次に、SMTP サービスの起動を確認しました。
上記のスクリプトが動いたので SMTP サービスが起動されているものと思っていましたが、管理者用ＰＣにも職員用ＰＣにも SMTP 自体がインストールされていませんでした。
SMTP はネットワークにあっても良いようなのですが、それでも社内には存在しません。
しかし、管理者用ＰＣでは上記のスクリプトでメール送信ができるのです。
そして、職員用ＰＣでは同じことができないのです。

そこで、外部の SMTP サーバを利用してメール送信をするという次のようなスクリプトを実行してみました。

     Set objCdoMessage = CreateObject("CDO.Message")
     With objCdoMessage
          .From = "hogehoge@iwatax.jp"
          .To = "iwata-tsukusu@docomo.jp"
          .Subject = "Test"
          .TextBody = "テストですよ。"
          .Configuration.Fields.Item _
               ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
          .Configuration.Fields.Item _
               ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.iwatax.jp"
          .Configuration.Fields.Item _
               ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
          .Configuration.Fields.Update
          .Send
     End With
     Set objCdoMessage = Nothing

すると、これなら管理者用ＰＣでも職員用ＰＣでもメール送信ができます。
ということは、やはり SMTP の問題です。
とすると、管理者用ＰＣと職員用ＰＣの違いは････。

結論をいえば････。
Outlook Express にメール・アカウントが登録されているかいないかの差でした。
cdosys.dll が Outlook Express のメール・アカウントを参照しているなんてどこにも載っていないのですけれど、これも周知のことなのでしょうか････??。
メール・アカウントのプロパティで、送信メール関係の内容（SMTP サーバー名や送信ポート番号）を誤ったものにすると、送信できなくなります。
ということで、確かに cdosys.dll は、 Outlook Express（Windows というべきか?）のメール・アカウントで設定された SMTP サーバーを利用している、といえます。

なんとなく納得いくようないかないような････。
まあ、このコラムのネタができたことをよろこびましょうか（最近ネタ切れで････^^;;）。

なお、CDO.Message を EXCEL等の VBA で事前バインディングするなら Microsoft CDO for Windows 2000 Library を参照設定します。

◆閑話休題 (4)◆　VBScript の Option Explicit と On Error Resume Next での怖い話

VBA や VBS では必ず Option Explicit で変数の宣言を強制することにしています。
これによりつづりの誤りなどによる無用なバグを防ぐことができる････、
と信じていました。
ところが VBScript ではこの常識が通用しないことがあります（怖いですね〜）。

VBScript が思うように動かない原因を調べていたときに発見(?)しました。
なんと On Error Resume Next で Option Explicit が機能しないのです。

次のスクリプトでためしてみましょう。

     Option Explicit
     On Error Resume Next
     Msgboxx "hoge", vbOkOnly
     On Error Goto 0
     Msgboxx "hogehoge", vbOkOnly

実行すれば、とうぜん「この変数は宣言されていません。: 'Msgboxx'」という実行時エラーとなります。
ところが、どこでエラーになっているかといえば、「行: 5」と表示されます。
３行めの Msgboxx ではないのです。
On Error Resume Next から On Error Goto 0 までのあいだで Option Explicit が機能していません。
次のようにエラーチェックを入れると On Error Resume Next が優先？されているのがわかります。

     Option Explicit
     On Error Resume Next
     Msgboxx "hoge", vbOkOnly
     If (Err.Number = 0) Then
     Else
          Msgbox "Error: " & Err.Description, vbOkOnly
          Err.Clear
     End If

VBA ではコンパイルでエラーになります。VBScript だけの問題です。
ウェブで検索してみたら「[ASP] Option Explicit と On Error Resume Next」(http://blog.livedoor.jp/vtwin_engine/archives/3867987.html)というのがありました。
ほかにめぼしいものが引っかかりませんでしたが、周知のことなのでしょうか････。

Option Explicit があるから、つづり間違いはないと思い込んでいると思わぬ落とし穴が････。(^^;;
いずれにせよ On Error Resume Next を使うときはエラーチェックを適切におこなう必要があります。

◆道具26◆　プログラムのバージョンをチェックしてアップデートを起動する

私どもの会計事務所専用のシステムは、ミロク情報サービス(MJS)の ACELINK Navi というものです。
会計事務所専用システムでは、税法の変更などによりアップデートが頻繁にあります。
ACELINK Navi は社内用のシステムと社外(持ち出し)用のシステムが別々になっていて、各々にアップデートが必要になります。
社内用のシステムでは、起動時にアップデートがあるときはその旨のメッセージが表示され実行させられるのですが、社外用の ACELINK Navi (オフライン・システムという)には、どういうわけかそのような仕組みはありません。アップデート・プログラムが別にあって、わざわざそれを起動しなければならないのです（みんなにアナウンスするのもたいへんです）。
ということで、アップデートされていないオフライン・システムで、新しいバージョンのデータを処理する状況がありうるわけです(たぶんエラーになる!?)。
これを防ぐには、コンピュータ管理者(私です^^;)がすべてのPCについてアップデートを実行するか、または別の仕組みでなんとかするか････です。

ということで、別の仕組みでなんとかすることにしました。(^^)
ログオン時のスクリプトで、「オフライン・システムのバージョンをレジストリィによりチェックし、最新でなければアップデート・プログラムを起動する」というコードを追加しました。
こんな感じになります。

     Const c_strNewVersion = "1.94"
     Const HKEY_LOCAL_MACHINE = &H80000002
     Const c_strComputer = "."

     Dim objRegistry
     Dim objShell

     Dim strPrompt
     Dim lngResult

     Dim strKeyPath
     Dim strValueName
     Dim strValue

     Set objRegistry = GetObject("winmgmts:\\" & c_strComputer & "\root\default:StdRegProv")
     strKeyPath = "SOFTWARE\MJS\MJSNC\MJSOFFEA\MJSKEY\Client"
     strValueName = "installversion"
     objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
     If (IsNull(strValue) = True) Then
     Else
     '    最新バージョンか?
          If (strValue <> c_strNewVersion) Then
               strPrompt = "ミロク情報サービスの「オフラインシステム」を最新にする必要があります。" _
                              & vbCrLf & vbCrLf _
                              & "バージョンアップしますか？" & vbCrLf & vbCrLf & vbCrLf _
                              & "　　■■　これには約３０分の時間がかかります　■■"
               lngResult = Msgbox(strPrompt, vbYesNo + vbDefaultButton2, "インストールの確認")
               If (lngResult = vbYes) Then
     '             アップデート・プログラムを起動する。
                    Set objShell = WScript.CreateObject ("WSCript.shell")
                    objShell.Run "\\ServerHoge\MJSOnlineUpdate\MJSOfflineUpdate.exe C:\Program Files\MJS\MJSOfflineUpdate", 3, False
                    Set objShell = Nothing
               Else
               End If
          Else
          End If
     End If

     Set objRegistry = Nothing

バージョンの入っているレジストリィ・キーは、レジストリィ・エディタで検索をかけたら簡単に見つかりました。
最新バージョンがリリースされたら、このスクリプトの c_strNewVersion の値を変更します。
そして、1台のノート PC で実際にアップデートし、このスクリプトの strPrompt での所要時間も変更します。

なお、社内用のシステムのバージョンが入っているレジストリィ・キーは、
     \HKEY_LOCAL_MACHINE\SOFTWARE\MJS\MJSNC\MJSOFFE\SERVERHOGE\Client の installversion です。
社内用システム（こちらは必ず最新になる）と社外用システムのバージョンを比較して（バージョンは必ず一致する）、社外用システムの更新の有無をチェックするというロジックも考えましたが、運用上の理由から上記コードにしました。

これでとても運用がラクになりました。この仕組みは他でも使えそうですね。(^^)

(2011/06/20 追記)
6月17日に MJS から ACELINK Navi の差分アップデートというのがリリースされました。
知りませんでしたが、この差分アップデートというのはバージョンが変わらないのです。
つまり、上記のスクリプトのロジックでは穴があるわけです。
レジストリィではない別のなにかでアップデートの有無を判断できないものかと思っていますが、見つけられそうもない状況です。
とりあえず、差分アップデートの場合はアップデートすべきＰＣの名前をつけた空のファイルが特定のフォルダ（\\ServerHoge\Temp\）にあるものとする処理を追加することにしました。

     Set objWshNetwork = Wscript.CreateObject("Wscript.Network")
     strPcName = objWshNetwork.ComputerName
     Set objWshNetwork = Nothing

     Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = "\\ServerHoge\Temp\" & strPcName
If (objFSO.FileExists(strFilePath) = True) Then
      strPrompt = "ミロク情報サービスの「オフラインシステム」を最新にする必要があります。" _
                     & vbCrLf & vbCrLf _
                     & "バージョンアップしますか？" & vbCrLf & vbCrLf & vbCrLf _
                     & "　　■■　これには約３０分の時間がかかります　■■"
      lngResult = Msgbox(strPrompt, vbYesNo + vbDefaultButton2, "インストールの確認")
      If (lngResult = vbYes) Then
'             ファイルの削除後にアップデートを起動する。
               objFSO.DeleteFile strFilePath, True
               Set objShell = WScript.CreateObject ("WSCript.shell")
               objShell.Run "\\ServerHoge\MJSOnlineUpdate\MJSOfflineUpdate.exe C:\Program Files\MJS\MJSOfflineUpdate", 3, False
               Set objShell = Nothing
          Else
          End If
     Else
     End If
     Set objFSO = Nothing

◆道具25◆　VBScript でデバイスの有効と無効を制御する

DELL のノート PC Latitude E5510 でシャットダウンがうまくいかないことがあります。シャットダウンの途中、デスクトップアイコンなどが消えて後は電源が切れるだけというところでフリーズします。
どうも無線 LAN と有線 LAN がどちらも有効になっていると、この現象が起きることがあるようです（必ず発生するわけではありません）。
デバイスマネージャで無線 LAN を無効にすれば発生しません（Latitude E5510 には手前に「ワイヤレススイッチ」があり、それで無線 LAN をオフにしても現象が発生します)。

そもそも無線 LAN と有線 LAN を同時に接続しても問題にならない････はず（!?)。
というものの、デバイスを無効にすればシャットダウンに問題はでないし、タスクトレイから目障りな無線 LAN 関係のアイコンが消えるので、通常はデバイスを無効にしておくことにします。
そして必要なときは簡単に有効にする････。
つまり、VBScript でデバイスの有効と無効を制御すれば良いという話になります。

Hey, Scripting Guy! かどこかで、そのものズバリのスクリプトが見つかるかと期待しましたが、残念なことに見あたらないので作ることにします。
デバイスマネージャの機能を持つコマンドライン・ユーティリティ DevCon.exe (http://support.microsoft.com/kb/311272/ja) という便利なツールがあります。ダウンロードして C:\WINDOWS フォルダ(どこでも良い)に置きます。
これと、これのパラメータとなるハードウェア ID の取得に WMI を利用すれば簡単に実現できます (^^)。

     Const c_strComputer = "."
     Const c_strDeviceName = "hogehoge Wireless WLAN Half-Mini Card"

     Dim objWMIService
     Dim objDevices
     Dim objDevice
     Dim objDrivers
     Dim objDriver
     Dim objShell

     Dim strPrompt
     Dim lngResult

     Set objWMIService = GetObject("winmgmts:\\" & c_strComputer & "\root\cimv2")
     Set objDevices = objWMIService.ExecQuery("Select * from Win32_PnPEntity Where Name = '" & c_strDeviceName & "'")
     For Each objDevice In objDevices
          If (objDevice.Status = "OK") Then
               strPrompt = c_strDeviceName & " を無効にしますか？"
          Else
               strPrompt = c_strDeviceName & " を有効にしますか？"
          End If
          lngResult = Msgbox(strPrompt, vbYesNo, "確認")
          If (lngResult = vbYes) Then
               Set objDrivers = objWMIService.ExecQuery("Select * From Win32_PnPSignedDriver Where DeviceName = '" & c_strDeviceName & "'")
               For Each objDriver In objDrivers
                    Set objShell = WScript.CreateObject ("WSCript.shell")
                    If (objDevice.Status = "OK") Then
                         objShell.Run "cmd.exe /c C:\WINDOWS\DevCon.exe disable """ & objDriver.HardwareID & """", 7, False
                    Else
                         objShell.Run "cmd.exe /c C:\WINDOWS\DevCon.exe enable """ & objDriver.HardwareID & """", 7, False
                    End If
                    Set objShell = Nothing
               Next
          Else
          End If
     Next
     Set objDriver = Nothing
     Set objDrivers = Nothing
     Set objDevice = Nothing
     Set objDevices = Nothing
     Set objWMIService = Nothing

WMI の Win32_PnPEntity クラスだけで DevCon.exe のデバイスの指定ができると思いましたが、DeviceID などではうまく動作しません（時間がなくて調べられませんでした）。このため（苦し紛れに）、Win32_PnPSignedDriver クラスから HardwareID を取得しています。
上記では Status でデバイスの有効・無効を判定しているため Win32_PnPEntity クラスが必要ですが、この処理がなければ Win32_PnPSignedDriver クラスだけのスッキリしたコードになります。
デバイスの有効・無効の判定は StatusInfo がそのものズバリのようですが、データ型が uint16 なので VBScript では扱えません。そのため Status で代用しています(有効のときは OK、無効のときは Error になるようです)。

このスクリプトとは別に、ログオン時のスクリプトで無線 LAN を無効にするコードを実行させます。
そして、無線 LAN を利用するとき、利用し終わったとき、ユーザにこのスクリプトを実行してもらいます。

なお、対象となる無線 LAN デバイスがない PC でこのスクリプトを実行しても問題ありません。

(2011/06/08 追記)
ところで、HardwareID はマシン毎に違う可能性があると思い、上記コードではデバイス名から HardwareID を取得するようにしましたが、どうも固有の文字列のようです。
今回のデバイスの HardwareID は、
     PCI\VEN_14E4&DEV_4727&SUBSYS_00101028&REV_01
で、数台の Latitude E5510 でみな同じでした。
この文字列の最後の REV_01 はリビジョンを表しているようですが、これが変わる可能性はあるのでしょうか？
変わらないのであれば HardwareID をそのまま指定すればコードがスッキリするのですが････。
ハードウェアのリビジョンでしょうから、故障による部品交換で変わる可能性がないとはいえないと思う(^^;)ので、このままにします。

(2011/06/14 追記)
MSDN では WMI の Win32_PnPEntity クラスに HardwareID があるようになっている(http://msdn.microsoft.com/en-us/library/aa394353(v=vs.85).aspx)のに、うまくいかない（「オブジェクトでサポートされていないプロパティまたはメソッドです」というエラーになる）ので、なんだろうかと思っていました。
ふと WMI にもバージョンの違いがあることを思い出したので、Windows7 でためしてみました（私どものクライアントは Windows XP SP-3 なのです）。
すると Win32_PnPEntity クラスに HardwareID が確かにありました。
というわけで、Windows7 では Win32_PnPEntity クラスだけのスッキリしたコードになります。
          If (lngResult = vbYes) Then
               Set objShell = WScript.CreateObject ("WSCript.shell")
               If (objDevice.Status = "OK") Then
                    objShell.Run "cmd.exe /c C:\WINDOWS\DevCon.exe disable """ & objDevice.HardwareID(0) & """", 7, False
               Else
                    objShell.Run "cmd.exe /c C:\WINDOWS\DevCon.exe enable """ & objDevice.HardwareID(0) & """", 7, False
               End If
               Set objShell = Nothing
          Else
          End If
Win32_PnPEntity クラスの HardwareID は配列なんですね。必ず (0) でよいかどうかまで検証できていません（また、Win32_PnPSignedDriver クラスの HardwareID はなぜ配列ではないのでしょう）。
なお、Windows7 でも DevCon.exe は動作しました。

(2011/06/17 追記)
パソコンの節電について調べていたら、マイクロソフトの「Windows パソコンを節電して使う術」(http://go.microsoft.com/?linkid=9772068)という PDF の11ページに「有線ネットワークがある場合は無線 LAN をオフに」という Tips がありました。
我ながらなんというタイミングの良さでしょう。(^^)

(2012/09/21 追記)
Windows XP から Windows 7 に更新する予定で、現在 Windows 7 の環境の設定と検証をしています。
上記のスクリプトはそのままでは動きませんでした。なぜかといえばデバイス名が変わっていたのです。Windows XP では「hogehoge Wireless WLAN Half-Mini Card」でしたが、Windows 7 では「hogehoge Wireless WLAN Half-Mini カード」となっていました。こんなこともあるのですね。

(2013/08/29 追記)
Windows 8 の動作検証で知ったのですが、DevCon.exe に 64 ビット版があります。64 ビット OS にはこれを入れないと動作しません。これは http://it.thelibrarie.com/utilities/devcon_x64.zip からダウンロードするのが簡単です。

◆道具24◆　SQL Server のコンピュータ名を変更する

スタンドアロンの SQL Server ではコンピュータ名を変更すると不具合がでることがあります。
これに対処するには次のようなプロシージャを実行したのち、SQL Server を再起動します。

既定のインスタンスの場合
     sp_dropserver <'old_name'>
     GO
     sp_addserver <'new_name'>, local
     GO

名前付きインスタンスの場合
     sp_dropserver <'old_name\instancename'>
     GO
     sp_addserver <'new_name\instancename'>, local
     GO

コンピュータ名を変更することはあまりないでしょうが、パソコン導入時に Windows 環境をイメージ展開する場合は、次のようなスクリプトがあれば SQL Server のコンピュータ名を変更するのも容易です。

     Const c_strTitle = "コンピュータ名の変更"
     Const c_strFileName = "C:\Temp\SqlNameChange.sql"
     Const c_strOldPcName = "hogehoge1"

     Dim objWshNetwork
     Dim objFSO
     Dim objTextS
     Dim objShell

     Dim strPrompt
     Dim strPcName
     Dim strText

     ' ＰＣ名を取得する
     Set objWshNetwork = Wscript.CreateObject("Wscript.Network")
     strPcName = objWshNetwork.ComputerName
     Set objWshNetwork = Nothing

     strPrompt = "SQL Server のコンピュータ名を" & vbCrLf & vbCrLf _
                         & c_strOldPcName & " から " & strPcName & " に変更します"
     Msgbox strPrompt, vbOkOnly, c_strTitle

     ' クエリファイルを作成する
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set objTextS = objFSO.CreateTextFile(c_strFileName, True)
     strText = "sp_dropserver '" & c_strOldPcName & "'" & vbCrLf & "Go" & vbCrLf _
                & "sp_addserver '" & strPcName & "', local" & vbCrLf & "Go"
     objTextS.WriteLine strText
     Set objTextS = Nothing

     ' クエリを実行する
     Set objShell = WScript.CreateObject ("WSCript.shell")
     objShell.Run "sqlcmd.exe -S " & strPcName & " -E -i " & c_strFileName
     Set objShell = Nothing

     ' クエリファイルを削除する
     objFSO.DeleteFile c_strFileName, True
     Set objFSO = Nothing

     strPrompt = "終了しました。" & vbCrLf & vbCrLf _
                         & "再起動してください。"
     Msgbox strPrompt, vbOkOnly, c_strTitle

MSDE2000 であれば sqlcmd.exe の代わりに osql.exe を起動するように変更しましょう。
なお、MSDE（SQL Server 7.0）はこれではうまくいきません。再インストールとなります。

また、アプリケーションによってはレジストリィにコンピュータ名を書込んでいることがあるので、起動しない場合はレジストリィを確認したり、アプリケーションに環境構築ツールがないか調べてみましょう。

◆道具23◆　VBScript でレジストリィを修正する

Windows Server 2008 R2 からクライアントＰＣにメッセージを送るのに net send が使えないので msg.exe を使用することにしました(道具1参照)。
ところが、「セッション名の取得エラー５」というエラーになります。
これは、ターミナルサービスセッションに対するリモートからのRPC接続が無効に設定されているせい、だそうです。
たしかにクライアントＰＣの次のレジストリィを修正すると、エラーがでなくなります。
　　(キー) 　　　　HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server
　　(値の名前)　AllowRemoteRPC
　　(タイプ)　　　 REG_DWORD
　　(値) 　　　　　1

すべてのクライアントＰＣのレジストリィをいじらなければならないので、次のコードを書きました。
上記のレジストリィ値はデフォルトで存在しないので、存在していないときに書き込むロジックにしてあります。

     Const HKEY_LOCAL_MACHINE = &H80000002
     Const c_strComputer = "."

     Dim objRegistry
     Dim strKeyPath
     Dim strDwName
     Dim strDwValue

     Set objRegistry = GetObject("winmgmts:\\" & c_strComputer & "\root\default:StdRegProv")
     strKeyPath = "SYSTEM\CurrentControlSet\Control\Terminal Server"
     strDwName = "AllowRemoteRPC"
     objRegistry.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath, strDwName, strDwValue
     If (IsNull(strDwValue) = True) Then
     '   存在していないので、レジストリィに追加する。
          strDwValue = 1
          objRegistry.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath, strDwName, strDwValue
     Else
     End If
     Set objRegistry = Nothing

意外にスクリプトでレジストリィの値を書き換えられると便利です。
上記では DWORD 値（REG_DWORD）を操作していますが、文字列値（REG_SZ）なら GetStringValue メソッドや SetStringValue メソッドを、バイナリ値（REG_BINARY）なら GetBinaryValue メソッドや SetBinaryValue メソッドを使用します。
また、HKEY_LOCAL_MACHINE 以外は次のように定義します。
     Const HKEY_CLASSES_ROOT = &H80000000
     Const HKEY_CURRENT_USER = &H80000001
     Const HKEY_USERS = &H80000003
     Const HKEY_CURRENT_CONFIG = &H80000005

今回は、Hey, Scripting Guy! の「値がレジストリに存在するかどうかを確認することはできますか」(http://gallery.technet.microsoft.com/scriptcenter/e9dcec76-cc6b-46b7-95b1-39ba7e81765e/)をはじめとした、スクリプトセンターのスクリプト集のお世話になりました。(^^)

(2012/03/14 追記)
ここでは msg.exe で「セッション名の取得エラー５」となったことから VBS でレジストリィを操作する話題をとりあげたのですが、msg.exe で「エラー1722: RPC サーバーを利用できません」となることもあります。これはファイアーウォールによるものであれば、Windows XP なら例外に「ファイルとプリンタの共有」を追加すれば解消するでしょう(^^)。

(2012/04/28 追記)
msg.exe で「ターミナルサーバーＰＣ名を開けませんでした。エラー [5]:アクセスが拒否されました」となることもあります。
ワークグループの相手 PC に送り手と同じユーザーアカウント（もちろんパスワードもおなじ）を登録してなかったため、このエラーになったことがありました。ワークグループとドメインの混在環境で、ふつうは使用しないアカウントであったためなかなか原因がわかりませんでしたが、わかってみれば単純な話でした(^^;;。
このページのアクセスログを見ると msg.exe の検索が多いので参考になれば幸いです。

(2012/09/21 追記)
Windows XP から Windows 7 に更新する予定で、現在 Windows 7 の環境の設定と検証をしています。
Windows XP では AllowRemoteRPC　のレジストリィ値がデフォルトで存在しないので上記のコードにしたのですが、Windows 7 では存在していたので（値は０）、IF 文をとって必ず１を設定するようにしました。考えてみれば最初からそうすればよかった。(^^;;
また、Windows 7 のＰＣに対する msg.exe で「ターミナルサーバーＰＣ名を開けませんでした。エラー[1722]: RPC サーバーを利用できません」となる場合、Windows 7 のシステムのプロパティでリモートデスクトップが「このコンピュータへの接続を許可しない」になっていたら他のにしてみましょう。Windows Server 2008 R2 などでも試してみてください。

◆閑話休題 (3)◆　AHCI の PC に Windows XP をインストールする

DELL のノートPC Latitude E5510 を購入しました。
Windows 7 Professional 機なのですが、しばらくは Windows XP で使うことにしました。

蛇足ですが、Latitude E5510 では購入時、Windows 7 と Office2010 の組み合わせではパーティション分割のオプションがない、Windows XP ダウングレードと Office2010 の組み合わせがない　という制限がありました。
私どもでは熟慮した結果(^^;)、Windows 7 と Office2010 を購入しました。
ですが、やはり使い慣れた Windows XP がいいですね。インストールしなおすことにしました。

Windows XP のインストール CD は Volume License のものがあるので、こういうときに便利です。 SA をつけていればイメージ展開の権利もあるのです。<-- うそかも(^^;;

ふつうにインストールすると、じきにブルースクリーンで止まってしまいます。これは AHCI のハードディスクのドライバがインストール CD には入っていないからです。
これに対処する方法は通常２つあります。(1).BIOS で AHCI を ATA としてからインストールする、(2).ドライバを捜してインストールする　です。

まず、(1).BIOS で AHCI を ATA としてからインストールする方法。
Latitude E5510 の場合、 BIOS に F2 で入り、System Configuration の中の SATA Operation を選んで、AHCI から ATA に変更します。これでふつうにインストールできるようになります。

せっかくの AHCI だから ATA モードにしたくないという方は (2).ドライバを捜してインストールする方法で。
いちおう説明しますと、Latitude E5510 の場合、Intel(R) 5 Series 4 Port SATA AHCI Controller のドライバが欲しいので捜します。Intel の Web では捜せませんでしたが Lenovo のところで見つけました。
Intel(R) SATA controller AHCI driver (Version: 9.5.7.1002) というものです。
解凍したファイルとフォルダをフロッピィにコピーしたら準備完了です。
Windows XP のインストールを開始した最初のころに「どっかの SCSI や RAID のドライバがあったら F6 キーを押してね」というようなメッセージがでたら、数回 F6 を押します。すぐには反応がないのですが、そのうち「追加するなら S キーを押してね」となり、「フロッピィを入れたら Enter を押してね」と続きます。先ほどのドライバが正しければ画面のリストの中に Intel(R) 5 Series 4 Port SATA AHCI Controlle（矢印キーで上を表示させます）がありますから、選んだら Enter を押します。続けて Enter を押すことによりインストールを継続します。フロッピィはしばらくそのままにしておきましょう。

いい忘れましたが、Latitude E5510 で Windows XP にダウングレードしたり、Windows 7 と Office2010 の組み合わせでパーティションを切ったりするのはサポート外となります。ご注意ください。

(2013/09/30 追記)
Windows XP にダウングレードして使用していた PC を Windows 7 にインストールしなおす場合、Windows XP を Acronis True Image などで別の PC にクローンを作ると、環境を確認しながら作業できるのでとても便利です。
今回、ATA の PC の Windows XP のイメージにより AHCI の Latitude E5510 でクローンを作ったのですが、起動時にブルースクリーンになり、ちょっとあわてました。ATA と AHCI の違いに気がついたので、BIOS で AHCI を ATA とすることで解決しました。

◆閑話休題 (2)◆　Internet Explorer における証明書エラーに対応する

ウイルスバスタービジネスセキュリティの管理コンソールを最初に立ち上げたときなどに、Internet Explorer から「この Web サイトのセキュリティ証明書には問題があります。」といわれることがあります。
Internet Explore ６から７や８にバージョンアップしたときも表示されますから、知らないとちょっぴり驚きます。(^^;;
これは https セキュリティ強化によるもので、信頼できる Web サイトであれば証明書をインストールすることにより解消できます。
次の手順によります。<-- Internet Explorer ８の場合（７でも同様です）

　　(1).「この Web サイトのセキュリティ証明書には問題があります。」の画面で「このサイトの閲覧を続行する（推奨されません）。」をクリックします。
　　(2).アドレスバーの右側の「証明書のエラー」と表示されているところをクリックします。
　　(3).「証明書は信頼できません」の表示で「証明書の表示」をクリックします。
　　(4).「証明書」ダイアログの「全般」タブにある「証明書のインストール」ボタンをクリックします。
　　(5).「証明書のインポートウィザード」が表示されるので「次へ」ボタンをクリックします。
　　(6).「証明書ストア」ダイアログで「証明書をすべて次のストアに配置する」を選び、参照で「信頼されたルート証明機関」を指定します。
　　(7).「証明書のインポートウィザードの完了」ダイアログで「完了」ボタンをクリックします。
　　(8).「セキュリティの警告」ダイアログで「はい」ボタンをクリックします。
　　(9).「正しくインポートされました。」と表示されたら「OK」ボタンをクリックします。
　(10).「証明書」ダイアログに戻るので「OK」ボタンをクリックします。
　(11).Internet Explorer を再起動します。

◆閑話休題 (1)◆　EXCEL VBA のプログラミングではセルに名前をつけましょう

EXCEL VBA でセル(またはセル範囲)を参照するとき、Range("A1") などと記述できます。
が、これでは Range("A1") がどのようなものかわかりませんし、何より Range("A1") の位置を Range("B2") に移動したときにコードを変更する必要が生じてしまいます。

この保守性の悪さについては、セル(セル範囲)に名前をつけることで簡単に解決できます。
EXCEL VBA の書籍などではセル参照での名前について、その効能など説明がほとんどありませんが、実はたいへん重要なことなのです。

例えば、道具22では
     Range("指示_TrackID").Cells(lngRowNo + 1, 1) _
                    = pf_GetTrackID(Range("指示_FAX番号").Cells(lngRowNo + 1, 1), _
                                                       Sheets("Sheet1"), Range("指示_送信時刻"))
というコードがあります。
「指示」シートの「TrackID」という見出しのセルに「指示_TrackID」という名前をつけてあり、Range("指示_TrackID") でセル参照しています。このことは誰もが一見してわかります（<-- たぶん^^;;）。
また、仮に「Range("指示_TrackID")」のセル位置（列位置）を変えたとしても、参照範囲が自動的に変更されるため、コードにはまったく影響ありません。ほんとうにありがたいことです。

名前をつける操作は、名前をつけたいシートのセル範囲を選択し、挿入(I) --> 名前(N) --> 定義(D) により「名前の定義」ダイアログを表示させて、名前を入力する　というようになります。<-- EXCEL 2003 の場合

なお、ワークシート関数においても、セル(セル範囲)につけた名前を利用できます。
     =VLOOKUP(A1,科目_検索範囲,2,FALSE)
これも可読性があがったのではないでしょうか。(^^)

EXCEL を使うときには、せっかくですからセルに名前をつけてみませんか？

◆道具22◆　ＥｘｃｅｌＶＢＡでリコー複合機のＰＣＦＡＸ機能を使用する

パソコンから複数のお客さまへ同じ文書をファックスする場合、「まいと〜く FAX」を使用しています。便利は便利なのですが、ちょっと操作がめんどうです。
そして、リコーの Operius 開発パートナープログラム Basic 契約（無償）によるドキュメントには、PC FAX ドライバー API を使用したサンプルプログラムが付属しています。<-- リコーさん、ありがとう。(^^)

というわけで、リコーのデジタルフルカラー複合機(RICOH imagio MP C3300)の PC FAX ドライバー API により EXCEL から一斉送信するコードを VBA で作成しました。
今回、税制改正の外部セミナーを開催するので、その案内の Word 文書で試してみることにします。

まず、標準モジュールに次のようなコードを書きます。

     ' PC-FAX API関数の宣言
     Declare Function IfxOpenEx Lib "Ifxapi32" (ByVal ppapa As String) As Long
     Declare Function IfxSender Lib "Ifxapi32" (ByVal hifx As Long, ByVal num As Long, ByVal FAX As String) As Long
     Declare Function IfxStartTime Lib "Ifxapi32" (ByVal hifx As Long, ByVal TimeUse As Long, ByVal Time As Long) As Long
     Declare Function IfxTTI Lib "Ifxapi32" (ByVal hifx As Long, ByVal iparam As Long) As Long
     Declare Function IfxGetTrackID Lib "Ifxapi32" (ByVal hifx As Long, ByVal TrackID As String, ByVal size As Long) As Long
     Declare Function IfxLock Lib "Ifxapi32" (ByVal hifx As Long) As Long
     Declare Function IfxUnlock Lib "Ifxapi32" (ByVal hifx As Long) As Long
     Declare Function IfxClose Lib "Ifxapi32" (ByVal hifx As Long) As Long
     Declare Function IfxGetSendResult Lib "Ifxapi32" (ByVal ip As String, ByVal TrackID As String, ByRef result As IfxSendResult) As Long
     Declare Function IfxForcedUnlock Lib "Ifxapi32" (ByVal hifx As Long) As Long
     'Declare Function IfxCheckPrinterDriver Lib "Ifxapi32" (ByVal prn As String) As Boolean
     Public Const IFX_E_SUCCESS = 0
     Public Const IFX_E_ERROR = -1
     Public Const IFX_E_LOCK = 10
     Public Const IFX_TTI_ON = 2

     ' SEND_RESULT 構造体
     Public Type IfxSendResult
          PageCount As Long
          DocNum As Long
          TotalAddress As Long
          Status As Long
          SubStatus As Long
          ErrorCode As Long
          UserID As String * 9
     End Type

     '---------------------------------------------------------
     ' ファックス送信
     '
     ' (IN)    ファックス番号(例 053-123-4567)、
     '           送信する文書(Word または Excel)、
     '           送信時刻(0〜2359)･･･時刻指定しない場合は 0 とする（従って 00:00 の送信は不可能）
     ' (OUT) TrackID
     '---------------------------------------------------------
     Public Function pf_GetTrackID(strFaxNo As String, objDocu As Object, lngStartTime As Long) As String

          Const c_strTitle As String = "ファックス送信"
     '   PC - FAX ドライバのプリンタ名
          Const c_strPrnName As String = "RICOH PCFAX(imagio MP C3300)"

          Dim strGetTrackID As String
          Dim strTrackID As String * 20
          Dim strStatus As String
          Dim strPrompt As String
          Dim lngHndle As Long
          Dim lngResult As Long
          Dim lngResponse As Long

          strGetTrackID = ""

     '   初期化処理
          lngHndle = IfxOpenEx(c_strPrnName)
          If (lngHndle = 0) Then
               strPrompt = "オープンに失敗しました。"
               MsgBox strPrompt, vbOKOnly, c_strTitle
               GoTo Exit_Proc
          Else
          End If

     '   送信あて先の設定
          lngResult = IfxSender(lngHndle, 1, strFaxNo)
     '    時刻指定送信の設定（0 は「設定しない」とする。00:00 の意味としない）
          If (lngStartTime = 0) Then
               lngResult = IfxStartTime(lngHndle, False, 0)
          Else
     '         VB の True は -1 のため使えない。
               lngResult = IfxStartTime(lngHndle, 1, lngStartTime)
          End If
     '   発信元名称を付加するの設定
          lngResult = IfxTTI(lngHndle, IFX_TTI_ON)
     '   TrackIDの取得
          lngResult = IfxGetTrackID(lngHndle, strTrackID, 20)
          If (lngResult = IFX_E_SUCCESS) Then
          Else
               strPrompt = "TrackID の取得に失敗しました。"
               MsgBox strPrompt, vbOKOnly, c_strTitle
               GoTo Exit_Proc
          End If

          strStatus = ""
          Do Until (strStatus <> "")
     '         設定ロック処理
               lngResult = IfxLock(lngHndle)
               If (lngResult = IFX_E_SUCCESS) Then
                    strStatus = "OK"
               Else
                    If (lngResult = IFX_E_LOCK) Then
                         strPrompt = "他のプロセスでロックされています。" & vbCrLf & vbCrLf _
                                        & "しばらく待ってＯＫを押してください。"
                         lngResponse = MsgBox(strPrompt, vbOKCancel, c_strTitle)
                         If (lngResponse = vbOK) Then
                         Else
                              strPrompt = "ロックを強制解除して処理を続行しますか？"
                              lngResponse = MsgBox(strPrompt, vbYesNo, c_strTitle)
                              If (lngResponse = vbYes) Then
     '                            設定ロックを強制的に解除
                                   lngResult = IfxForcedUnlock(lngHndle)
                              Else
                                   strPrompt = "処理を終了します。"
                                   MsgBox strPrompt, vbOKOnly, c_strTitle
                                   GoTo Exit_Proc
                              End If
                         End If
                    Else
                         strPrompt = "ロックに失敗しました。" & "(ErrorCode) " & lngResult _
                                        & vbCrLf & vbCrLf _
                                        & "処理を終了します。"
                         MsgBox strPrompt, vbOKOnly, c_strTitle
                         GoTo Exit_Proc
                    End If
               End If
          Loop

     '    Word と Excel で PrintOut メソッドの引数が違うので分岐する。
     '    (ActivePrinter が必ず PC-FAX ドライバであれば共通にしても良い)。
          If (LCase(Right(objDocu.Name, 4)) = ".doc") Then
     '        ワード文書の場合、ActivePrinter が PC-FAX ドライバか確認する。
               If (Left(Application.ActivePrinter, Len(c_strPrnName)) = c_strPrnName) Then
     '             Word での送信
                    objDocu.PrintOut Copies:=1
               Else
                    strPrompt = "通常使うプリンタが PC-FAX ドライバではありません。" _
                                 & vbCrLf & vbCrLf & "処理を終了します。"
                    MsgBox strPrompt, vbOKOnly, c_strTitle
     '              設定ロックの解除
                    lngResult = IfxUnlock(lngHndle)
                    GoTo Exit_Proc
               End If
          Else
     '         Excel での送信
               objDocu.PrintOut Copies:=1, ActivePrinter:=c_strPrnName
          End If

     '   設定ロックの解除
          lngResult = IfxUnlock(lngHndle)

          strGetTrackID = strTrackID

     Exit_Proc:
          If (lngHndle = 0) Then
          Else
     '         終了処理
               lngResult = IfxClose(lngHndle)
          End If

          pf_GetTrackID = strGetTrackID

     End Function

     '---------------------------------------------------------
     ' 送信結果の取得
     '
     ' (IN)    TrackID
     ' (OUT) 送信結果
     '---------------------------------------------------------
     Public Function pf_GetSendResult(strTrackID As String) As String

     '    192.168.1.1 は複合機のIPアドレス
          Const c_strIpAddress As String = "192.168.1.1"

          Dim strGetSendResult As String
          Dim usrSendResult As IfxSendResult
          Dim lngResult As Long

          lngResult = IfxGetSendResult(c_strIpAddress, strTrackID, usrSendResult)
          If (lngResult = IFX_E_SUCCESS) Then
               Select Case usrSendResult.Status
                    Case "&H0"
                         strGetSendResult = "送信完了"
                    Case "&H1"
                         strGetSendResult = "通信エラー"
                    Case "&H80"
                         strGetSendResult = "待機中"
                    Case "&H82"
                         strGetSendResult = "通信中"
                    Case "&H84"
                         strGetSendResult = "不達待機"
                    Case "&H86"
                         strGetSendResult = "レポート印刷などによる待ち（処理中）"
                    Case "&H2"
                         strGetSendResult = "送信中止(文書削除)"
                    Case "&HA0"
                         strGetSendResult = "PC から転送中"
                    Case "&H23"
                         strGetSendResult = "PC から転送終了(メモリーフルエラー)"
                    Case "&H25"
                         strGetSendResult = "PC から転送終了(ジョブフルエラー)"
                    Case "&H27"
                         strGetSendResult = "PC から転送終了(あて先指定エラー)"
                    Case "&H29"
                         strGetSendResult = "PC から転送終了(回線指定エラー)"
                    Case "&H21"
                         strGetSendResult = "PC から転送終了(その他エラー)"
                    Case "&H77"
                         strGetSendResult = "使用不可(利用制限)"
                    Case "&H73"
                         strGetSendResult = "中断"
                    Case "&H70"
                         strGetSendResult = "データイン開始"
                    Case "&H81"
                         strGetSendResult = "エラー(電源OFF)"
                    Case Else
                         strGetSendResult = "? "
               End Select
          Else
               strGetSendResult = "取得失敗 (" & lngResult & ")"
          End If

          pf_GetSendResult = strGetSendResult

     End Function

あとは、送付先リストのシートと送る内容のシートを作成し、ファックス送信する処理と、送信結果を取得する処理を記述すればできあがり（イメージできないかたはこちらを）。
ファックス送信する処理では、送付先リストからファックス番号を１件ずつ取り出して送信しますが、TrackID を送付先と対応づけて保持します。<-- 送信結果の取得で必要なため。
例えば、こんな感じです。

     Range("指示_TrackID").Cells(lngRowNo + 1, 1) _
                    = pf_GetTrackID(Range("指示_FAX番号").Cells(lngRowNo + 1, 1), _
                                                       Sheets("Sheet1"), Range("指示_送信時刻"))

送信結果を取得する処理では、送付先リストから TrackID を１件ずつ取り出して取得します。
あまり早いタイミングで送信結果を取得しようとすると、取得できなかったり、処理途中の送信結果を受け取ることになります。

ということで、何度も送信結果を取得できるようにしたり、不達の相手先だけに再送信できるようにプログラミングしましょう。

送信する文書は Word 文書も想定しているので、どこかに次のようなコードを入れます。<-- このとき忘れずに「Microsoft Word ××.× Object Library」を参照設定しましょう。

     Dim objWord As Word.Application
     Dim objWordDocu As Word.Document

     Set objWord = New Word.Application
     objWord.Visible = True
     Set objWordDocu = objWord.Documents.Open("C:\Temp\サンプル文書.doc")
     ' プレビュー後に送信する
     objWordDocu.PrintPreview
     Msgbox "送信します"
     Range("指示_TrackID").Cells(lngRowNo + 1, 1) _
                    = pf_GetTrackID(Range("指示_FAX番号").Cells(lngRowNo + 1, 1), _
                                                       objWordDocu, Range("指示_送信時刻"))
     objWordDocu.Close SaveChanges:=False
     objWord.Quit
     Set objWordDocu = Nothing
     Set objWord = Nothing

ファックス設定では、時刻指定送信およびTTI（発信元名称を付加する)設定しかしていません。
場合によっては考えたほうが良いかもしれません。デフォルトの設定内容は次の通りです。
          ・送信件数               0 件
          ・ファクス番号リスト   なし
          ・送信方式               通常送信方式
          ・線密度                  小さな字
          ・同時印刷               同時印刷しない
          ・時刻指定送信         時刻指定送信しない
          ・TTI                       TTI なし
          ・圧縮方式               MMR 圧縮方式
          ・回線種別               G3
          ・一括送信               一括送信しない
          ・送付状                  添付なし
          ・ファイル                 出力しない

とても簡単で便利です。
ただ、とりあえずこれで動作していますが、送信結果の取得に失敗する原因不明の現象が見られます（送信じたいは成功しています････。この場合、なんどか送信結果の取得をおこなうか、複合機のパネルで送信結果を確認します）。
また、送信内容と送信件数によっては複合機のメモリがいっぱいになり、解消されるまで受信不能となる事態も想定されるので、運用上の注意が必要です。

(2011/12/22 追記)
送信結果の取得に失敗する現象については、よくある質問に「送信結果取得を連続して実行する際には約10秒程度間隔をあけて IfxGetSendResult をコールしてください。待機処理を入れないと失敗する場合があります」とありました。10秒の間隔をあける処理を実装するのがめんどうなのでこのままです^^;;。
また、メモリがいっぱいになる件については、一括送信の機能を利用すればよいと思われますが、これまた調べたり実装したりするのがめんどうなのでこのままです。

(2013/10/22 追記)
リコーの「Operius 開発パートナープログラム」は「Ricoh Developer Program」と名称変更されました。

(2014/05/15 追記)
昨年末のことなのですが、とある方からメールをいただきました。
「上記のコードを参考にして作成したプログラムがあります。PC を Windows XP から Windows 7 (64bit) にしたところ『実行時エラー'53'　ファイルが見つかりません』というエラーになり動きません。原因と対策を教えてください」とのことです。

64bit の Windows OS に 32bit の Office をインストールした環境では、PC FAX ドライバが 32bit であっても 64bit であっても上記コードは動作しません。

その原因は、64bit OS においては 32bit の Office が WOW64 という仕組みで動作するためで、それによる制限です。詳細は「32bitアプリを64bit Windows 7で動かす『WOW64』(https://ascii.jp/elem/000/000/480/480200/) 」を参照してください。
そこには「WOW64 は、32bit プログラムと 64bit プログラムを、ひとつのプロセス内で混在させて実行できない。そのため、64bit プログラムで呼び出せる DLL は 64bit DLL だけだし、32bit の DLL は呼び出せない。もちろん 32bit プログラムからの 64bit DLL 呼び出しもできない。」とあります。

ということで、対策といっても、OS、ドライバ、Office のすべてを 32Bit か 64bit のいずれかに揃えるしかありません。64bit Office が選択できるのは Office 2010 以降です。
ただし、「Microsoft Office の 32 ビット版と 64 ビット版を選択する (http://office.microsoft.com/ja-jp/word-help/HA010369476.aspx)」にあるように、64bit 版を選択すると別の互換の問題が出そうです。

また、64Bit を選択した場合はコードの修正が必要です。
VBA で API 関数を使用している場合、修正しないで実行すると「このプロジェクトのコードは、64 ビットシステムで使用するために更新する必要があります。Declare ステートメントに PtrSafe 属性を設定してください。」というエラーメッセージが表示されます。
それ以外でも 32bit と 64bit の互換もとる必要があります。これらのために、Office 2010 から VBA はバージョン7にあがっているようです。

ということで、標準モジュールの PC-FAX API 関数の宣言を次のように修正します。
#If VBA7 And Win64 Then
Declare PtrSafe Function IfxOpenEx Lib "Ifxapi64" (ByVal ppapa As String) As LongPtr
Declare PtrSafe Function IfxSender Lib "Ifxapi64" (ByVal hifx As LongPtr, ByVal num As Long, ByVal FAX As String) As Long
Declare PtrSafe Function IfxStartTime Lib "Ifxapi64" (ByVal hifx As LongPtr, ByVal TimeUse As Long, ByVal Time As Long) As Long
Declare PtrSafe Function IfxTTI Lib "Ifxapi64" (ByVal hifx As LongPtr, ByVal iparam As Long) As Long
Declare PtrSafe Function IfxGetTrackID Lib "Ifxapi64" (ByVal hifx As LongPtr, ByVal TrackID As String, ByVal size As Long) As Long
Declare PtrSafe Function IfxLock Lib "Ifxapi64" (ByVal hifx As LongPtr) As Long
Declare PtrSafe Function IfxUnlock Lib "Ifxapi64" (ByVal hifx As LongPtr) As Long
Declare PtrSafe Function IfxClose Lib "Ifxapi64" (ByVal hifx As LongPtr) As Long
Declare PtrSafe Function IfxGetSendResult Lib "Ifxapi64" (ByVal ip As String, ByVal TrackID As String, ByRef result As IfxSendResult) As Long
Declare PtrSafe Function IfxForcedUnlock Lib "Ifxapi64" (ByVal hifx As LongPtr) As Long
' Declare Function IfxCheckPrinterDriver Lib "Ifxapi64" (ByVal prn As String) As Boolean
#Else
Declare Function IfxOpenEx Lib "Ifxapi32" (ByVal ppapa As String) As Long
Declare Function IfxSender Lib "Ifxapi32" (ByVal hifx As Long, ByVal num As Long, ByVal FAX As String) As Long
Declare Function IfxStartTime Lib "Ifxapi32" (ByVal hifx As Long, ByVal TimeUse As Long, ByVal Time As Long) As Long
Declare Function IfxTTI Lib "Ifxapi32" (ByVal hifx As Long, ByVal iparam As Long) As Long
Declare Function IfxGetTrackID Lib "Ifxapi32" (ByVal hifx As Long, ByVal TrackID As String, ByVal size As Long) As Long
Declare Function IfxLock Lib "Ifxapi32" (ByVal hifx As Long) As Long
Declare Function IfxUnlock Lib "Ifxapi32" (ByVal hifx As Long) As Long
Declare Function IfxClose Lib "Ifxapi32" (ByVal hifx As Long) As Long
Declare Function IfxGetSendResult Lib "Ifxapi32" (ByVal ip As String, ByVal TrackID As String, ByRef result As IfxSendResult) As Long
Declare Function IfxForcedUnlock Lib "Ifxapi32" (ByVal hifx As Long) As Long
' Declare Function IfxCheckPrinterDriver Lib "Ifxapi32" (ByVal prn As String) As Boolean
#End If

標準モジュールのプロシージャ pf_GetTrackID でもハンドルを定義しているので、そこも忘れずに修正しましょう。
#If VBA7 And Win64 Then
Dim lngHndle As LongPtr
#Else
Dim lngHndle As Long
#End If

簡単な修正で良かった(^^)。

◆道具21◆　パラメータマーカーを使用して動的ＳＱＬ

SQL 文で条件を変えたいような場合、パラメータマーカーを使用して動的 SQL（パラメータクエリ）にするとスマートです。
VBScript ではこんな感じになります。

     Const c_strSql = "Select Count(*) As 件数 From TempDB.dbo.hogehoge1 Where (項目1 = ?) And (項目2 = ?) And (項目3 = ?) "

     Dim objAdoConnect
     Dim objAdoCommand
     Dim objAdoCmdPara
     Dim objAdoRs

     Set objAdoConnect = CreateObject("ADODB.Connection")
     objAdoConnect.ConnectionTimeout = 10
     objAdoConnect.CommandTimeout = 0
     objAdoConnect.Provider = "SQLOLEDB"
     objAdoConnect.Properties("Data Source") = "Serverhogehoge"
     objAdoConnect.Properties("Initial Catalog") = "TempDB"
     objAdoConnect.Properties("Extended Properties") = "Trusted_Connection=Yes"
     objAdoConnect.Open

     Set objAdoCommand = CreateObject("ADODB.Command")
     objAdoCommand.CommandText = c_strSql
     objAdoCommand.ActiveConnection = objAdoConnect
     objAdoCommand.CommandType = 1
     Set objAdoCmdPara = objAdoCommand.CreateParameter("項目1", 200, 1, 12, CStr(InputBox ("項目1 は？")))
     objAdoCommand.Parameters.Append objAdoCmdPara
     Set objAdoCmdPara = objAdoCommand.CreateParameter("項目2", 200, 1, 12, CStr(InputBox ("項目2 は？")))
     objAdoCommand.Parameters.Append objAdoCmdPara
     Set objAdoCmdPara = objAdoCommand.CreateParameter("項目3", 200, 1, 12, CStr(InputBox ("項目3 は？")))
     objAdoCommand.Parameters.Append objAdoCmdPara

     Set objAdoRs = objAdoCommand.Execute
     If (objAdoRs.EOF = True) Then
          MsgBox "データなし"
     Else
          MsgBox objAdoRs.Fields("件数")
     End If
     objAdoConnect.Close

     Set objAdoRs = Nothing
     Set objAdoCmdPara = Nothing
     Set objAdoCommand = Nothing
     Set objAdoConnect = Nothing

プロバイダ SQLOLEDB の場合、パラメータマーカーは疑問符(?)です。実際の値は、疑問符の出現順にパラメータコレクションに追加して与えます。

なお、EXCEL等の VBA で事前バインディングするなら Microsoft ActiveX Data Objects 2.8 Library を参照設定します。<-- 2.8 は環境等によります。
参照設定した場合、組み込み定数が自動メンバ表示されるので、例えば上記 CreateParameter メソッドは次のようにわかりやすく記述できます。
     Set objAdoCmdPara = objAdoCommand.CreateParameter("項目1", adVarChar, adParamInput, 12, CStr(InputBox("項目1 は？ ")))

ところで EXCEL では "外部データの取り込み" 機能を使えば、データベースの内容を簡単に取り込むことができます。単純な SQL なら VBA の出番はないのですが、条件を変えたい場合は次のような感じになります。
     Const c_strSql_1_1 As String = "Select * From TempDB.dbo.hogehoge1 Where (項目1 >= "
     Const c_strSql_1_2 As String = ") And (項目2 = "
     Const c_strSql_1_3 As String = ") And (項目3 = "
     Const c_strSql_1_4 As String = ") Order By 項目1, 項目2, 項目3 "

     With Sheets("Sheet1")
          .Select
          .Range("A1").Select
          strSql = c_strSql_1_1 & CStr(InputBox ("項目1 は？")) _
                    & c_strSql_1_2 & CStr(InputBox ("項目2 は？")) _
                    & c_strSql_1_3 & CStr(InputBox ("項目3 は？")) & c_strSql_1_4
          .QueryTables(1).Sql = strSql
          .QueryTables(1).Refresh BackgroundQuery:=False
     End With
パラメータマーカーが使えませんから、やはり SQL 文がわかりにくいですね。

どうしてもパラメータマーカで実装したいという人は、CopyFromRecordset メソッドを使用しましょう。
     Set objAdoRs = objAdoCommand.Execute
     If (objAdoRs.EOF = True) Then
          MsgBox "データなし"
     Else
          Sheets("Sheet1").Range("A1").CopyFromRecordset objAdoRs
     End If
ただし、これには最初にシートの内容を消去したり、見出しを設定したり、そのほか細かい処理が必要ですし、一般的な実装方法でないのでやめておきましょう(^^)。

(2011/10/21 追記)
EXCEL の "外部データの取り込み" でもパラメータマーカーが使えました（ごめんなさい、不勉強でした）。
クエリテーブルに Parameters コレクションオブジェクトと Parameter オブジェクトというのがありました。
こんな感じでコードが書けます。

     Const c_strSql As String = "Select Count(*) As 件数 From TempDB.dbo.hogehoge1 Where (項目1 = ?) And (項目2 = ?) And (項目3 = ?) "
     Dim objQueryTable As QueryTable
     Dim objParameter As Parameter

     With Sheets("Sheet1")
          Set objQueryTable = .QueryTables(1)
          objQueryTable.Sql = c_strSql
          Set objParameter = objQueryTable.Parameters.Add("項目1", xlParamTypeVarChar)
          objParameter.SetParam xlRange, .Range("項目1")
          Set objParameter = objQueryTable.Parameters.Add("項目2", xlParamTypeVarChar)
          objParameter.SetParam xlRange, .Range("項目2")
          Set objParameter = objQueryTable.Parameters.Add("項目3", xlParamTypeVarChar)
          objParameter.SetParam xlRange, .Range("項目3")
          objQueryTable.Refresh BackgroundQuery:=False
          Set objParameter = Nothing
          Set objQueryTable = Nothing
     End With

Parameter オブジェクトの SetParam メソッドの第１引数では、セルの値を指定(xlRange)していますが、第２引数の値を指定(xlConstant)したり、値の入力のダイアログボックスを表示させる指定(xlPrompt)をすることもできます。

◆道具20◆　サービスを無効にする

元ネタは、Hey, Scripting Guy! の「サービスを無効にする方法はありますか」<-- まんま ^^;; (http://gallery.technet.microsoft.com/scriptcenter/023d30d0-9b7e-47d2-babd-250da5d6a70d)です。

     Set objLocator = CreateObject("WbemScripting.SWbemLocator")
     Set objWMIService = objLocator.ConnectServer
     For Each objQfe In objWMIService.ExecQuery("Select * From Win32_Service Where Name='Browser'")
          If (objQfe.State = "Running") Then
               lngResult = objQfe.StopService()
               lngResult = objQfe.ChangeStartMode ("Disabled")
          Else
     '          lngResult = objQfe.ChangeStartMode ("Manual")
     '          lngResult = objQfe.StartService()
          End If
     Next

上の例では Computer Browser サービスを無効にしています。これは「マスタブラウザは、自分がトランスポート NetBT_Tcpip_{×-×-×-× のドメインのマスタブラウザであると認識している別のコンピュータ hogehoge からサーバーアナウンスを受信しました。マスタブラウザが停止しているか、またはブラウザの選択中です」といったサーバーのイベントがうるさいためです。
コンピュータ名を識別して影響ないＰＣだけを無効にしましょう。
Computer Browser サービスのプロパティをひらくとサービス名が Browser となっているので Where 文には Name='Browser' とします。Computer Browser は表示名なのですね。

(2013/04/15 追記)
私どもではミロク情報サービスの ACELINK NX-Pro というシステムを使用しています。このシステムの持出し用であるオフラインシステムでは、たまに「事務所コントロールＤＢに接続できません」といわれて起動できないことがあります。これはデータベースのサービスが開始しないことによるもので、当該サービスを開始するスクリプト（コードはこちら）をつくって対応しています。
ミロク情報サービスのシステムをつかっているとクビをかしげることがありますが、これもそのひとつです。ユーザーにしわ寄せがいくことがないよう、システムでなんとかしようとは思わないのでしょうかね？

◆道具19◆　ネットワークアダプタの TCP/IP のプロパティを設定する

Windows Management Instrumentation(WMI) を使用すれば、ネットワークアダプタの TCP/IP のプロパティを設定することができます。

     lngCount = 0
     strPcName = "."
     Set objWMIService = GetObject("winmgmts:" _
                         & "{impersonationLevel=impersonate}!\\" & strPcName & "\root\cimv2")
     Set objAdapters = objWMIService.ExecQuery _
                         ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

     For Each objAdapter In objAdapters
          lngCount = lngCount + 1
     '    IPアドレスとサブネットマスクの設定
      lngResult = objAdapter.EnableStatic(Array("192.168.1.101"), Array("255.255.255.0"))
      If (lngResult = 0) Then
      Else
           Msgbox "Status: " & lngResult, vbOKOnly, "EnableStatic"
      End If
     '    DNSサーバーアドレス(使用順)の設定
          lngResult = objAdapter.SetDNSServerSearchOrder(Array("192.168.1.1"))
          If (lngResult = 0) Then
          Else
               Msgbox "Status: " & lngResult, vbOKOnly, "SetDNSServerSearchOrder"
          End If
     '   デフォルトゲートウェイの設定
          lngResult = objAdapter.SetGateways(Array("192.168.1.1"))
          If (lngResult = 0) Then
          Else
               Msgbox "Status: " & lngResult, vbOKOnly, "SetGateways"
          End If
     Next
     ' DNSサフィックスを順に追加の設定
     Set objNetwork = objWMIService.Get("Win32_NetworkAdapterConfiguration")
     lngResult = objNetwork.SetDNSSuffixSearchOrder(Array("hogehoge.co.jp"))
     If (lngResult = 0) Then
     Else
          Msgbox "Status: " & lngResult, vbOKOnly, "SetDNSSuffixSearchOrder"
     End If

     Set objNetwork = Nothing
     Set objAdapter = Nothing
     Set objAdapters = Nothing
     Set objWMIService = Nothing

     If (lngCount <= 1) Then
     Else
          Msgbox lngCount & " 個のネットワークアダプタを設定しました"
     End If

設定値を配列で与えるのは複数の値を持つことができるからですね。空にするのもこのように。
     lngResult = objAdapter.SetGateways(Array())

固定 IP アドレスではなく、「IP アドレスを自動的に取得する」に設定するなら
     lngResult = objAdapter.EnableDHCP()
とし、「DNS サーバーのアドレスを自動的に取得する」に設定するなら
     lngResult = objAdapter.SetDNSServerSearchOrder(Array())
とします。

ネットワークアダプタが２個以上ある場合は
     If (objAdapter.Description = "Intel(R) hogehoge Network Connection") Then
のようにアダプタを識別して処理しましょう。

上記コードで strPcName に自分以外のＰＣのコンピュータ名や IP アドレスを指定すれば、リモートから制御できます。例えば、管理 PC から他の PC をインターネットに接続できるようにしたり、できないようにしたり、と自由自在です。

ところで、EXCEL等の VBA で事前バインディングするための参照設定を調べたところ、
     Set objWMIService = GetObject("winmgmts:" _
                         & "{impersonationLevel=impersonate}!\\" & strPcName & "\root\cimv2")
のところは次のコーディングと同じようです。
     Set objLocator = CreateObject("WbemScripting.SWbemLocator")
     Set objWMIService = objLocator.ConnectServer(strPcName, "\root\cimv2")
EXCEL等の VBA で事前バインディングするなら、Microsoft WMI Scripting V1.2 Library を参照設定すればよいようです。
     Dim objWbemLocator As SWbemLocator
     Dim objWMIService As SWbemServices
     Dim objAdapters As SWbemObjectSet
     Dim objAdapter As SWbemObject

     Set objWbemLocator = New SWbemLocator
     Set objWMIService = objWbemLocator.ConnectServer(strPcName, "\root\cimv2")
     Set objAdapters = objWMIService.ExecQuery _
                         ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
     For Each objAdapter In objAdapters
ただし、これによって Win32_NetworkAdapterConfiguration 等のプロパティやメソッドが参照できるわけではないので、事前バインディングする意味がないような気が･･････。

蛇足ですが、ConnectServer メソッドでは、ユーザアカウントとパスワードも指定できます。Hey, Scripting Guy! では「別の資格情報のもとでスクリプトを実行するにはどうすればよいでしょうか」(http://gallery.technet.microsoft.com/scriptcenter/2e42ea9f-dbb3-4972-b56d-b13cb397359b) というテクニックが紹介されています。

(2011/06/08 追記)
WMI を使用してリモートから制御する場合は、管理者権限やファイアウォールの関係でスクリプトがうまく動作しないことがあります。
詳細は「WMI スクリプトと WMI サービスに関する問題のトラブルシューティング(http://gallery.technet.microsoft.com/scriptcenter/c9531a37-dc90-4674-ad10-678bd5d97533)」を参照してください。

(2012/09/13 追記)
Windows XP から Windows 7 に更新する予定で、現在 Windows 7 の環境の設定と検証をしているのですが、上記のコードでうまく設定できないものがあります。
インターネットに接続できるようにするしないをデフォルトゲートウェイの設定で制御しています。Windows 7 では
          lngResult = objAdapter.SetGateways(Array("192.168.1.1"))
は設定できても、空にする
     lngResult = objAdapter.SetGateways(Array())
はうまくいきません。エラーにもなりません（lngResult は０）。
しかたがないので Netsh コマンドで空にすることにしました。
     Set objShell = CreateObject ("WSCript.shell")
     objShell.Run "cmd.exe /c netsh interface ipv4 delete address " _
               & "name=""ローカルエリア接続"" addr=192.168.1.199 gateway=all", 7, True
     Set objShell = Nothing
delete address では IP アドレスを省略してデフォルトゲートウェイだけ削除できるように記載されているのですが、ためしてみると IP アドレスを省略できませんでした。そのため、ダミーの IP アドレス（192.168.1.199）を指定してあります。
なお、Windows 7 マシンかどうかはコンピュータ名により判断しています（命名規則により可能なのです）。

(2016/09/07 追記)
Windows 7 から Windows 10 に更新する予定で、現在 Windows 10 の環境の設定と検証をしているのですが、上記の Netsh コマンドが「要素が見つかりません」というエラーになってしまいます。
しかたがないので次のように変更しました。Windows 10 ではインターフェイス名も変更されていました。
     objShell.Run "cmd.exe /c netsh interface ipv4 set add name=""イーサネット"" source=static addr="  & objAdapter.IPAddress(0) & " mask=255.255.255.0 none", 7, True

◆道具18◆　ネットワークアダプタの TCP/IP のプロパティを取得する

Windows Management Instrumentation(WMI) を使用すれば、ネットワークアダプタの TCP/IP のプロパティを取得することができます。

     strPcName = "."
     Set objWMIService = GetObject("winmgmts:" _
                         & "{impersonationLevel=impersonate}!\\" & strPcName & "\root\cimv2")
     Set objAdapters = objWMIService.ExecQuery _
                         ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

     For Each objAdapter In objAdapters
          strPrompt = " (1) " & objAdapter.Description & vbCrLf _
                         & " (2) " & objAdapter.MACAddress & vbCrLf _
                         & " (3) " & objAdapter.DNSHostName & vbCrLf
          If (IsNull(objAdapter.IPAddress) = False) Then
               For lngIndex = 0 To UBound(objAdapter.IPAddress)
                    strPrompt = strPrompt & " (4-" & lngIndex & ")" _
                                   & objAdapter.IPAddress(lngIndex) & vbCrLf
               Next
          Else
          End If
          If (IsNull(objAdapter.IPSubnet) = False) Then
               For lngIndex = 0 To UBound(objAdapter.IPSubnet)
                    strPrompt = strPrompt & " (5-" & lngIndex & ")" _
                                   & objAdapter.IPSubnet(lngIndex) & vbCrLf
               Next
          Else
          End If
          If (IsNull(objAdapter.DefaultIPGateway) = False) Then
               For lngIndex = 0 To UBound(objAdapter.DefaultIPGateway)
                    strPrompt = strPrompt & " (6-" & lngIndex & ")" _
                                   & objAdapter.DefaultIPGateway(lngIndex) & vbCrLf
               Next
          Else
          End If
          If (IsNull(objAdapter.DNSServerSearchOrder) = False) Then
               For lngIndex = 0 To UBound(objAdapter.DNSServerSearchOrder)
                    strPrompt = strPrompt & " (7-" & lngIndex & ")" _
                                   & objAdapter.DNSServerSearchOrder(lngIndex) & vbCrLf
               Next
          Else
          End If
          strPrompt = strPrompt & " (8) " & objAdapter.DNSDomain & vbCrLf
          If (IsNull(objAdapter.DNSDomainSuffixSearchOrder) = False) Then
               For lngIndex = 0 To UBound(objAdapter.DNSDomainSuffixSearchOrder)
                    strPrompt = strPrompt & " (9-" & lngIndex & ")" _
                                   & objAdapter.DNSDomainSuffixSearchOrder(lngIndex) & vbCrLf
               Next
          Else
          End If
          strPrompt = strPrompt & "(10) " & objAdapter.DHCPEnabled & vbCrLf _
                         & "(11) " & objAdapter.DHCPServer & vbCrLf
          If (IsNull(objAdapter.DHCPLeaseObtained) = False) Then
               strPrompt = strPrompt & "(12) " _
                              & objAdapter.DHCPLeaseObtained & vbCrLf
          Else
          End If
          If (IsNull(objAdapter.DHCPLeaseExpires) = False) Then
               strPrompt = strPrompt & "(13) " _
                              & objAdapter.DHCPLeaseExpires & vbCrLf
          Else
          End If
          strPrompt = strPrompt & "(14) " & objAdapter.WINSPrimaryServer & vbCrLf _
                         & "(15) " & objAdapter.WINSSecondaryServer & vbCrLf
          If (IsNull(objAdapter.DNSServerSearchOrder) = False) Then
               For lngIndex = 0 To UBound(objAdapter.DNSServerSearchOrder)
                    strPrompt = strPrompt & "(16-" & lngIndex & ")" _
                                   & objAdapter.DNSServerSearchOrder(lngIndex) & vbCrLf
               Next
          Else
          End If

          Msgbox strPrompt

     Next

     Set objAdapter = Nothing
     Set objAdapters = Nothing
     Set objWMIService = Nothing

◆道具17◆　リコー複合機と SNMP で通信する

リコーのデジタルフルカラー複合機(RICOH imagio MP C3300)の「標準 MIB 仕様書」が手に入ったので SNMP で通信してみました。<-- リコーの Operius 開発パートナープログラム Basic の契約（無償）をしたので。

     Set objSNMP = CreateObject("OlePrn.OleSNMP")
     ' 192.168.1.1 は複合機のIPアドレス
     objSNMP.Open "192.168.1.1", "public", 2, 1000
     strObjectValue = objSNMP.Get(".1.3.6.1.2.1.43.16.5.1.2.1.1")
     Msgbox strObjectValue, vbOkOnly, "SNMP"
     objSNMP.Close
     Set objSNMP = Nothing

この例では、オブジェクト prtConsoleDisplayBufferText（1.3.6.1.2.1.43.16.5.1.2.1.1）に対し、「余熱モード待機中」などの応答が返ってきます。

なお、OlePrn.OleSNMP を EXCEL等の VBA で事前バインディングするなら OlePrn 1.0 Type Library (oleprn.dll) を参照設定します。

残念ながら標準 MIB では運用上で役に立ちそうなアイデアは思いつきませんでした（どなたかヒントを････）。
Private MIB 仕様書などをみてみたいのですが、有償（Premier 契約で年間５万円）になるのでそこまでは････。
無償である Basic 契約でも EXCEL の VBA で PC FAX ドライバー API を使用した請求書送信サンプルなどがあり、とてもうれしくなります。
興味のある方はリコーの Operius 開発パートナープログラムのウェブをご覧ください。

また、PC FAX ドライバー API を使用して一斉送信する EXCEL のコードについては道具22を参照してください。

◆道具16◆　リコー複合機のカウンタ情報を取得する

コピーとファックスをリコーのデジタルフルカラー複合機(RICOH imagio MP C3300)に更新しました。
フルカラーコピーはきれいですが、コストが高くつくのがタマにキズです。使用枚数などの稼動状況を時々チェックする必要がありそうです。

この複合機では HTTP でカウンタ情報などの機器情報を閲覧できます(Web Image Monitor といいます。画像)。ということは VBScript でそのコンテンツをテキストで取得できれば問題は解決です。
スクリプトセンターに「Web ページがアクセス可能かどうかを確認する方法はありますか」(http://gallery.technet.microsoft.com/scriptcenter/bcc6e41e-ddbd-4fb8-9d24-a32e90ebd850)というのがありました（その後 MSXML2.XMLHTTP で検索するといろいろな情報が得られました）。
次のようなスクリプトでカウンタ情報を取得できることを確認しました。

     On Error Resume Next

     'コンテンツの取得
     Set objHTTP = CreateObject("MSXML2.XMLHTTP")
     '192.168.1.1 は複合機のIPアドレス
     strUrl = "http://192.168.1.1/web/guest/ja/websys/status/getUnificationCounter.cgi"
     Call objHTTP.Open("GET", strUrl, FALSE)
     objHTTP.Send
     strText = objHTTP.ResponseText
     Set objHTTP = Nothing
     If (Err.Number = 0) Then
     Else
          Wscript.Quit
     End If

     On Error Goto 0

     'トータル枚数
     strSearch = "トータル</td><td nowrap>:</td><td nowrap>"
     strCounter = pf_GetCounter(strText, 1, strSearch, "<")
     lngPosition = pf_GetPosition(strText, 1, strSearch)
     Msgbox "トータル枚数: " & strCounter
     'コピー白黒枚数
     strSearch = "白黒</td><td nowrap>:</td><td nowrap>"
     strCounter = pf_GetCounter(strText, lngPosition, strSearch, "<")
     lngPosition = pf_GetPosition(strText, lngPosition, strSearch)
     Msgbox "コピー白黒枚数: " & strCounter
               ･･････以下すべてのカウンタ値を取得する

     '----------------------------------------------------------
     ' テキスト(strText)から
     ' 開始位置(lngPosition)から以降にある
     ' 開始文字列(strSearchStr1)と
     ' 終了文字列(strSearchStr2)
     ' の間の文字列(＝カウンタ値)を取出す
     '----------------------------------------------------------
     Private Function pf_GetCounter(strText, lngPosition, strSearchStr1, strSearchStr2)

          Dim strCounter
          Dim varPosition1
          Dim varPosition2

          On Error Resume Next

          varPosition1 = InStr(lngPosition, strText, strSearchStr1)
          If (varPosition1 > 0) Then
               varPosition1 = varPosition1 + Len(strSearchStr1)
               varPosition2 = InStr(varPosition1, strText, strSearchStr2)
               If (varPosition2 > 0) Then
                    strCounter = Mid(strText, varPosition1, varPosition2 - varPosition1)
               Else
                    strCounter = "Error"
               End If
          Else
               strCounter = "Error"
          End If

          If (Err.Number = 0) Then
          Else
               strCounter = "Error"
               Err.Clear
          End If

          pf_GetCounter = strCounter

     End Function

     '----------------------------------------------------------
     ' テキスト(strText)から
     ' 開始位置(lngPosition)から以降にある
     ' 文字列(strSearchStr)の次の文字の位置を求める
     '----------------------------------------------------------
     Private Function pf_GetPosition(strText, lngPosition, strSearchStr)

               （省略）

     End Function

これにファイル・アクセスの処理を追加します。

     strFileName = "C:\hogehoge\Counter.csv"
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     If (objFSO.FileExists(strFileName) = True) Then
          ' 追加書込み
          Set objTextF = objFSO.OpenTextFile(strFileName, 8)
     Else
          ' ファイルの新規作成と見出し書込み
          Set objTextF = objFSO.CreateTextFile(strFileName, True)
          objTextF.WriteLine "日付," _
                                   & "トータル," _
                                   & "コピー白黒," _
                                   & "コピーカラー," _
                                   & "コピー単色," _
                                   & "コピー２色," _
                                   & "プリンタ白黒," _
                                   & "プリンタカラー," _
                                   & "プリンタ単色," _
                                   & "プリンタ２色," _
                                   & "ファックス白黒"
     End If

     '日付
     objTextF.Write FormatDateTime(Date, 2) & ","
     'トータル枚数
     strSearch = "トータル</td><td nowrap>:</td><td nowrap>"
     strCounter = pf_GetCounter(strText, 1, strSearch, "<")
     lngPosition = pf_GetPosition(strText, 1, strSearch)
     objTextF.Write strCounter & ","
               ･･････以下すべてのカウンタ値を書込む
     'ファックス白黒枚数
     strSearch = "白黒</td><td nowrap>:</td><td nowrap>"
     strCounter = pf_GetCounter(strText, lngPosition, strSearch, "<")
     objTextF.WriteLine strCounter

     objTextF.Close

     Set objTextF = Nothing
     Set objFSO = Nothing

このスクリプトをサーバーの起動時に実行するようスケジュールすれば完成です。

なお、EXCEL等の VBA で MSXML2.XMLHTTP を事前バインディングするなら Microsoft XML, v6.0 を参照設定します。<-- v6.0 は環境等によります。

◆道具15◆　開いているファイルをチェックする

サーバーのデータをバックアップする場合などにおいて、アプリケーションによってはファイルをつかんでいるためにコケてしまうことがあります。
コケてしまうファイル等の拡張子はわかるので、コンピュータの管理 − システムツール − 共有フォルダ − 開いているファイルの情報を VBScript で取得できれば、事前にチェックできます。

     Set objWshNetwork = Wscript.CreateObject("Wscript.Network")
     strPcName = objWshNetwork.ComputerName

     Set objConnection = GetObject("WinNT://" & strPcName & "/LanmanServer")
     lngCount = 0
     For Each objResource In objConnection.Resources
     '    該当する拡張子か？　小文字にしてチェックする
          If (LCase(Right(objResource.Path, 4) = ".abc" )) Then
               lngCount = lngCount + 1
          Else
          End If
     '   該当するフォルダか？
          If (InStr(objResource.Path, "\hogehoge\DATA\") > 0) Then
               lngCount = lngCount + 1
          Else
          End If
     Next

今回もWindows Management Instrumentation(WMI) です。
WMI を利用するといろいろな情報が取得できるので、おもしろい利用法を考えてみましょう。

今回の元ネタは、Hey, Scripting Guy! の「コンピュータ上で開いているセッションおよびファイルを一覧に表示する方法はありますか」(http://gallery.technet.microsoft.com/scriptcenter/56418820-8926-4517-a055-238ccf307117) です。Hey, Scripting Guy! ではおもしろいスクリプトがたくさん紹介されています。

◆道具14◆　イベントログをチェックする

サーバーのイベントログを常時チェックするのはたいへんです。異常が通知されるような仕組みがあれば便利です。
次のようなスクリプトをタスクスケジューラに登録して１時間ごとに実行させます。

     'ＰＣ名を取得する
     Set objWshNetwork = Wscript.CreateObject("Wscript.Network")
     strPcName = objWshNetwork.ComputerName
     Set objWshNetwork = Nothing

     lngOutCount = 0
     strDate = CStr(Year(Now) * 10000 + Month(Now) * 100 + Day(Now))
     Set objWinMgmts = GetObject("winmgmts:\\" & strPcName)
     '今日のイベントだけを抽出する
     Set objNTLogEvent = objWinMgmts.ExecQuery _
           ("Select * From Win32_NTLogEvent Where TimeGenerated >= '" & strDate & "'")
     If (objNTLogEvent.Count = 0) Then
     Else
        For Each objEvent In objNTLogEvent
     '     １時間前の警告かエラーのイベントだけを対象にする
           If ((objEvent.Type = "警告") Or (objEvent.Type = "エラー")) _
              And (CLng(Mid(objEvent.TimeGenerated, 9, 2)) = Hour(Now) - 1) Then
              If (lngOutCount = 0) Then
                 Set objFSO = CreateObject("Scripting.FileSystemObject")
                 Set objTextF = objFSO.CreateTextFile _
                    ("C:\Temp\" & "EventLog_" & strDate & "_" & Hour(Now) & ".txt", True)
              Else
              End If
              objTextF.WriteLine "コンピュータ: " & objEvent.ComputerName & vbCrLf _
                               & "ログファイル: " & objEvent.LogFile & vbCrLf _
                               & "      タイプ: " & objEvent.Type & vbCrLf _
                               & "    生成時刻: " & objEvent.TimeGenerated & vbCrLf _
                               & "      ソース: " & objEvent.SourceName & vbCrLf _
                               & "    イベント: " & objEvent.EventCode & vbCrLf _
                               & " メッセージ: " & objEvent.Message
              lngOutCount = lngOutCount + 1
           Else
           End If
        Next
        If (lngOutCount = 0) Then
        Else
           objTextF.Close
           Set objTextF = Nothing
           Set objFSO = Nothing
        End If
     End If
     Set objWinMgmts = Nothing
     Set objNTLogEvent = Nothing

    If (lngOutCount = 0) Then
     Else
     ' ログの表示と管理ＰＣへの通知
        Set objShell = WScript.CreateObject ("WSCript.shell")
        objShell.Run "C:\Temp\" & "EventLog_" & strDate & "_" & Hour(Now) & ".txt", 3, False
        objShell.Run "cmd.exe /c net send hogehoge " _
                     & strPcName & " のイベントを確認してください", 7, False
        Set objShell = Nothing
     End If

あとは、適当な期間が経過した EventLog.txt ファイルを削除する処理をいれて完成です。
    ' ７日以上前のものは削除する。
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objFile In objFSO.GetFolder("C:\Temp\").Files
        If (Left(objFile.Name, Len("EventLog_")) = "EventLog_") Then
            If (CLng(Mid(objFile.Name, Len("EventLog_") + 1, 8)) _
                 < CLng(Year(Now - 7) * 10000 + Month(Now - 7) * 100 + Day(Now - 7))) Then
               objFile.Delete True
            Else
            End If
        Else
        End If
    Next
    Set objFile = Nothing
    Set objFSO = Nothing

上記の"C:\Temp\" と "EventLog_" は実際には定数名にします。
セキュリティのログへのアクセスは別の方法となるようです。

EXCEL等の VBA で事前バインディングするなら Wscript.Network および WSCript.shell は Windows Script Host Object Model を、FileSystemObject は Microsoft Scripting Runtime を参照設定します。
Windows Management Instrumentation(WMI) の参照設定はよくわかりません。

なお、
     Set objWinMgmts = GetObject("winmgmts:\\" & strPcName)
では自分以外のＰＣでも良いので、クライアントＰＣの監視については管理ＰＣから各ＰＣのイベントログを見にいくことにします。

また、レコードを絞らずにすべてのイベントログを読み込んだとき、エラーとなる（エラー 0x8004106C、ソース(null)）ことがありました（ログの容量を減らすなどにより回避できます）ことを付記しておきます。

(2011/04/13 追記)
エラー 0x8004106C については「大容量イベントログ取得時によくある問題と回避策」（http://blogs.technet.com/b/jpilmblg/archive/2011/02/15/wmi-script-wevtutil-exe.aspx）にやや詳しい説明がありました。

(2011/08/10 追記)
Windows Server 2003 などでは上記のコードで問題ありませんが、Windows Server 2008 および 2008 R2 ではうまく動きませんでした。
調べてみると、生成時刻（objEvent.TimeGenerated）が UTC 形式になっているためでした。
仕様が変わったのか、それとも何らかの設定のせいなのか････ともあれ、UTC の場合は次のようにコードの一部を変更しましょう。
まず、クエリーの条件となる今日の日付をマイナス９時間することで UTC 値にします。
    dtmNow = DateAdd("h", -9, Now)
    strDate = CStr(Year(dtmNow) * 10000 + Month(dtmNow) * 100 + Day(dtmNow))

１時間前の警告かエラーのイベントだけを表示する判定も次のようにします。
    If ((objEvent.Type = "警告") Or (objEvent.Type = "エラー")) _
         And (CLng(Mid(objEvent.TimeGenerated, 9, 2)) = Hour(dtmNow) - 1) Then

あとは、表示のために生成時刻をプラス９時間して JST 値にします。
    dtmTimeGenerated = CDate(Left(objEvent.TimeGenerated, 4) & "/" _
                                  & Mid(objEvent.TimeGenerated, 5, 2) & "/" _
                                  & Mid(objEvent.TimeGenerated, 7, 2) & " " _
                                  & Mid(objEvent.TimeGenerated, 9, 2) & ":" _
                                & Mid(objEvent.TimeGenerated, 11, 2) & ":" _
                                & Mid(objEvent.TimeGenerated, 13, 2) )
    dtmTimeGenerated = DateAdd("h", +9, dtmTimeGenerated)
    objTextF.WriteLine "コンピュータ: " & objEvent.ComputerName & vbCrLf _
                                  & " 生成時刻: " & FormatDateTime(dtmTimeGenerated, 1) _
                                                 & " " & FormatDateTime(dtmTimeGenerated, 4) & vbCrLf _

(2013/01/31 追記)
上記のスクリプトでは当日のイベントを取り出していますが、別のスクリプトでは現在から何時間か以内のイベントを取り出す必要がありました。クエリーの条件で TimeGenerated に時間まで指定することにします。
    ' 現在より12時間前のイベントから対象にする
    dtmNow = DateAdd("h", -12, dtmNow)
    strDateTime = CStr(Year(dtmNow) * 10000 + Month(dtmNow) * 100 + Day(dtmNow)) _
         & Right("0" & CStr(Hour(dtmNow) * 10000 + Minute(dtmNow) * 100 + Second(dtmNow)), 6) _
         & ".000000-000"
    Set objWinMgmts = GetObject("winmgmts:\\" & strPcName)
    Set objNTLogEvent = objWinMgmts.ExecQuery _
              ("Select * From Win32_NTLogEvent Where TimeGenerated >= '" & strDateTime & "'")

◆道具13◆　SQL Server でテーブル定義を取得する

SQL Server のテーブルの定義が取得できるとなにかと便利です。
次の SQL を EXCEL と組み合わせれば手軽なツールになります。

Sysobjects からユーザテーブルの一覧を取得します。
     Select * From TempDB.dbo.sysobjects Where type = 'U' Order By name

これで目的のテーブルの id がわかるので syscolumns から必要なテーブルの定義項目を取得します。データ型の名前は systypes から取得します。
     Select T1.colid, T1.name, T2.name As type, T1.length, T1.isnullable, T1.prec, T1.scale
          From TempDB.dbo.syscolumns T1 Left Outer Join TempDB.dbo.systypes T2
                    On (T1.usertype = T2.usertype)
          Where (T1.id = 1234567890) Order By T1.colid

なお、SQL Server 2000 のものですが、システムテーブルマップという PDF ファイルがマイクロソフトの Web サイト(http://download.microsoft.com/download/3/5/6/3561f370-eafe-40de-8c89-19b6bd5ec39e/SQLSystemtable.pdf)からダウンロードできますから、ぜひご覧になってみてください。

◆道具12◆　Windows 認証で SQL Server に接続する

社内システムで SQL Server にアクセスするときは、セキュリティ上の理由から Windows 統合認証で接続するべきでしょう。
VBScript なら次のようになります。

      Dim objAdoConnect
      Dim objAdoRs

      Set objAdoConnect = CreateObject("ADODB.Connection")
      objAdoConnect.ConnectionTimeout = 10
      objAdoConnect.CommandTimeout = 0
      objAdoConnect.Provider = "SQLOLEDB"
      objAdoConnect.Properties("Data Source") = "(Local)"
      objAdoConnect.Properties("Initial Catalog") = "TempDB"
      objAdoConnect.Properties("Extended Properties") = "Trusted_Connection=Yes"
      objAdoConnect.Open

      Set objAdoRs = CreateObject("ADODB.Recordset")
      objAdoRs.Open "Select Count(*) As 件数 From TempDB.dbo.hogehoge", objAdoConnect, 2, 3
      If (objAdoRs.EOF = True) Then
         MsgBox "データなし"
      Else
        MsgBox objAdoRs.Fields("件数")
      End If
      objAdoRs.Close
      objAdoConnect.Close

      Set objAdoRs = Nothing
      Set objAdoConnect = Nothing

接続文字列を使用するのは好みでないため、プロパティを使ってます(^^)。
ここで Trusted_Connection=Yes がWindows 統合認証で接続することを意味していますが、この代わりに
      objAdoConnect.Properties("Integrated Security") = "SSPI"
としても同じようです。どのような違いがあるかは調べていません。

なお、EXCEL等の VBA で事前バインディングするなら Microsoft ActiveX Data Objects 2.8 Library を参照設定します。<-- 2.8 は環境等によります。
      Dim objAdoConnect As ADODB.Connection
      Dim objAdoRs As ADODB.Recordset

      Set objAdoConnect = New ADODB.Connection
      With objAdoConnect
         .ConnectionTimeout = 10
        .CommandTimeout = 0
        .Provider = "SQLOLEDB"
        .Properties("Data Source") = "(Local)"
        .Properties("Initial Catalog") = "TempDB"
        .Properties("Integrated Security") = "SSPI"
      End With
      objAdoConnect.Open

      Set objAdoRs = New ADODB.Recordset
      objAdoRs.Open "Select Count(*) As 件数 From TempDB.dbo.hogehoge", objAdoConnect, adOpenDynamic, adLockOptimistic
      If (objAdoRs.EOF = True) Then
         MsgBox "データなし"
      Else
         MsgBox objAdoRs.Fields("件数")
      End If
      objAdoRs.Close
      objAdoConnect.Close

      Set objAdoRs = Nothing
      Set objAdoConnect = Nothing

◆道具11◆　ファイルの更新日時を変更する

VBScript なら次のようにします。
      Set objShell = CreateObject("Shell.Application")
      Set objFolder = objShell.Namespace("C:\Temp")
      Set objFolderItem = objFolder.ParseName("hogehoge.txt")
      objFolderItem.ModifyDate = "2009/08/08 AM 8:08:00"

また、ファイルのプロパティの詳細も取得できます(設定できません)。
      '   インデックス 3 は更新日時
      MsgBox objFolder.GetDetailsOf(objFolder.Items, 3) & " : " _
             & objFolder.GetDetailsOf(objFolderItem, 3)
      '   インデックス 4 は作成日時
      MsgBox objFolder.GetDetailsOf(objFolder.Items, 4) & " : " _
             & objFolder.GetDetailsOf(objFolderItem, 4)
      '   インデックス 5 はアクセス日時
      MsgBox objFolder.GetDetailsOf(objFolder.Items, 5) & " : " _
             & objFolder.GetDetailsOf(objFolderItem, 5)

なお、Shell.Application を EXCEL等の VBA で事前バインディングするなら Microsoft Shell Controls And Automation (SHELL32.dll) を参照設定します。

◆道具10◆　SQL Server データベースの復旧

障害時におけるデータベースの復旧方法は次のとおりです。
データベースのフルバックアップがある場合はとても簡単です。
まず事前準備として master を復旧するクエリファイル（restore_master.sql）を作っておきます。
      /* master の復旧 */
      restore database master from disk = 'C:\SqlBackup\Master_Backup.BAK' with replace

master 以外を復旧するクエリファイル（restore_hogehoge.sql）も作っておきます。
      /* model の復元 */
      restore database model from disk = 'C:\SqlBackup\Model_Backup.BAK' with replace
      /* msdb の復元 */
      restore database msdb from disk = 'C:\SqlBackup\Msdb_Backup.BAK' with replace
      /* hogehoge1 の復元 */
      restore database hogehoge1 from disk = 'C:\SqlBackup\hogehoge1_Backup.BAK' with replace
      ････以下、データベースのすべてを復元します

次の手順で復旧します。SQL Server 2005 Express の例です。
(1).SQL Server と関連するサービスを停止します。
(2).SQL Server をシングルユーザモードで起動します。これは、コマンドプロンプトを開いておき、エクスプローラ等で sqlservr.exe を捜し、それをコマンドプロンプトにドラックアンドドロップして -m オプションで起動するのが簡単です。
      C:\>"C:\Program Files\Microsoft SQL Server\MSSQL.1\MSSQL\Binn\sqlservr.exe" -m
(3).エクスプローラ等で事前に作成したクエリファイルの restore_master.sql をダブルクリックします。Management Studio Express が起動したらデータベースに接続し、クエリを実行します。
(4).master が正常に復元されたことを確認し、Management Studio Express とコマンドプロンプトを終了します。
(5).SQL Server サービスを開始し、Management Studio Express で事前に作成したクエリファイルの restore_hogehoge.sql を実行します。
(6).すべてのデータベースが正常に復元されたことを確認し、関連するサービスを開始します。

(1)と(2)をバッチファイルにするなら次のように。
      Rem ■サービスの停止■
      net stop "MSSQLSERVER"
      net stop "SQLBrowser"
      net stop "SQLWriter"
      Rem ■SQL Server をシングルモードで起動する■
      "C:\Program Files\Microsoft SQL Server\MSSQL.1\MSSQL\Binn\sqlservr.exe" -m

(3)や(5)のクエリの実行は、クエリアナライザでも sqlcmd でも環境に応じて。
(3)はバッチファイルにするなら次のように。
      Rem ■クエリを実行する■　Windows 認証。管理者権限が必要
      sqlcmd -S (local) -E -i "C:\SqlBackup\restore_master.sql"
      Pause

(5)と(6)をバッチファイルにするなら次のように。
      Rem ■SQL Server サービスの開始■
      net start "MSSQLSERVER"
      Rem ■クエリを実行する■　Windows 認証。管理者権限が必要
      sqlcmd -S (local) -E -i "C:\SqlBackup\restore_hogehoge.sql"
      Rem ■関連サービスの開始■
      net start "SQLBrowser"
      net start "SQLWriter"
      Pause

なお、サーバーがこけてデータベースを復元しようとしたら、「新しく作ったデータベースがバックアップしてなかった!!」ということがないようにしましょう。(^^;;

復旧先の SQL Server は、こけた SQL Server と同じ状態（SP等）でないと復旧できません。

(2011/11/18 追記)
SQL Server 2008 Express （R2 ではない）でも動作確認しました。SQL Serve のパスだけは修正する必要がありました。既定のインスタンスの場合、シングルモードの起動は、
"C:\Program Files\Microsoft SQL Server\MSSQL10.MSSQLSERVER\MSSQL\Binn\sqlservr.exe" -m
となります。
ただし、64ビット OS（例えば Windows Server 2008 R2）と 32ビット OS とのあいだでバックアップとリカバリィをする場合は注意が必要です。
バックアップ・データのなかにパスがはいっているため、インストール・パスが違うとリカバリィに失敗します。
つまり、64ビット OS で C:\Program Files でなく C:\Program Files (x86) に SQL Server をインストールしていると失敗します。
動作検証では、Windows Server 2008 R2 側でバックアップを作成していたため、Windows Server 2003 R2（32ビット）側のほうで \Program Files (x86) フォルダを作成して SQL Server をインストールしなおし、回避しました。
というわけで 64ビット OS（例えば Windows Server 2008 R2) にはネイティブの 64ビット SQL Server 2008 Express （R2 ではない）をインストールしましょう。
なお、SQL Server 2005 Express には 64ビットネイティブがありませんから、確認してみてください。この記述のとおりになるものと思います（たぶん^^;;）。

◆道具９◆　最適化する

ドライブを最適化するバッチを月一回昼休みに実行するようスケジュールします。
      REM ■最適化する■
      REM　中断は Ctrl ＋ C
      Defrag C: -F
      Defrag D: -F
      PAUSE

VBScript なら次のようにします。
      ' デフラグを実行。終了まで待機
      strDrive = "C:"
     Set objShell = WScript.CreateObject ("WSCript.shell")
     objShell.Run "cmd.exe /c Defrag " & strDrive & " -F >C:\Temp\hogehoge.txt", 1, True
      ' レポートを表示
      objShell.Run "C:\Temp\ hogehoge.txt", 3, False
     Set objShell = Nothing

◆道具８◆　プリンタを削除する

プリンタを削除するには次のようにします。
      ' プリンタ(Printer01)の削除
      Set objShell = CreateObject("Shell.Application")
      For Each objPrinter In objShell.NameSpace(4).Items
         If (objPrinter.Name = "Printer01") Then
            Msgbox "Printer01 を削除したいので" & vbCrlf & vbCrlf _
                        & "このあとのメッセージに「はい」を選んでください", _
                        vbOKOnly, "管理者からのお願いです"
            objPrinter.InvokeVerb "削除(&D)"
            Exit For
         Else
         End If
      Next
      Set objPrinter = Nothing
      Set objShell = Nothing

上の例ではプリンタの削除をダイアログで確認しますが、Windows Management Instrumentation(WMI) を使用すると問答無用でプリンタを削除できます。
      ' WMIによるプリンタ(Microsoft Office Document Image Writer)の削除
      For Each objPrinter In GetObject("winmgmts:\\" & strPcName).InstancesOf("Win32_Printer")
         If (objPrinter.Name = "Microsoft Office Document Image Writer") Then
            objPrinter.Delete_
            Exit For
         Else
         End If
      Next
      Set objPrinter = Nothing

プリンタポートが Standard TCP/IP Port であればポートも WMI で削除できます。
      For Each objPort In GetObject("winmgmts:\\" & strPcName).InstancesOf("Win32_TCPIPPrinterPort")
         If (objPort.Name = "IP_192.168.1.1") Then
            objPort.Delete_
         Else
         End If
      Next
      Set objPort = Nothing

なお、プリンタ名の変更も WMI で簡単にできます。
      ' プリンタ名を Printer01 から Printer02 にする
      For Each objPrinter In GetObject("winmgmts:\\" & strPcName).InstancesOf("Win32_Printer")
         If (objPrinter.Name = "Printer01") Then
            objPrinter.RenamePrinter "Printer02"
            Exit For
         Else
         End If
      Next
      Set objPrinter = Nothing

◆道具７◆　通常使うプリンタを設定する

クライアントＰＣで電源投入時に実行させるスクリプト（道具６ Startup_hogehoge.vbs）には、保守のためのコードを書きます。
例えば、通常使うプリンタを設定するには次のようにします。
      ' Startup_hogehoge.vbs
      Set objWshNetwork = Wscript.CreateObject("Wscript.Network")
      strPcName = objWshNetwork.ComputerName
      Set objWshNetwork = Nothing
      Select Case strPcName
         Case "Desktop01"
            strPrinterName = "Printer01"
    End Select
      Set objShell = CreateObject("Shell.Application")
      For Each objPrinter In objShell.NameSpace(4).Items
         If (objPrinter.Name = strPrinterName) Then
            objPrinter.InvokeVerb "通常使うプリンタに設定(&F)"
            Exit For
         Else
         End If
      Next
      Set objPrinter = Nothing
      Set objShell = Nothing

例えば、(1).ユーザが通常使うプリンタを変更しても元に戻す、(2).プリンタ障害のときに別のプリンタを通常使うプリンタにする、(3).LAN に接続されていないときは携帯用プリンタを通常使うプリンタにする、のような利用法があります。なお、実行されるタイミングはログオン時（道具６による）であることに注意してください。

ここで同じ変数名 objShell を使用していますが、道具6などでの WSH の Shell オブジェクトと Shell.Application オブジェクトは別のものです。

なお、Wscript.Network を EXCEL等の VBA で事前バインディングするなら Windows Script Host Object Model を参照設定します。Shell.Application を EXCEL等の VBA で事前バインディングするなら Microsoft Shell Controls And Automation (SHELL32.dll) を参照設定します。

◆道具６◆　クライアントＰＣの電源投入時に最新のスクリプトを実行させる

クライアントＰＣで電源投入時（ログオン時）に実行させたいスクリプト（Startup_hogehoge.vbs）があります。このスクリプトは運用上の理由からローカルに置いて実行しますから、クライアントＰＣにダウンロードする仕掛けが必要です。
というわけで、最新のスクリプトをサーバーからコピーし起動するスクリプト（IPL_hogehoge.vbs）を作り、スタートアップに登録することにします（ログオンスクリプトに登録するのは分かりにくいのでお勧めしません。場合によってはタスクスケジューラに登録して一定間隔で実行させるという選択肢もあります）。

      ' IPL_hogehoge.vbs
      ' ドライブを取得する
      Set objShell = WScript.CreateObject ("WSCript.shell")
      strDrive = Left(objShell.CurrentDirectory, 1)
      Set objShell = Nothing
      ' サーバーからスクリプトをコピーする
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      objFSO.CopyFile "\\Svr_hogehoge\Tools\Startup_hogehoge.vbs", strDrive & ":\", True
      Set objFSO = Nothing
      If (Err.Number = 0) Then
      '     ダウンロードしたスクリプトを起動する
         Set objShell = WScript.CreateObject ("WSCript.shell")
       objShell.Run strDrive & ":\Startup_hogehoge.vbs", 4, False
         Set objShell = Nothing
      Else
      End If

なお、FileSystemObject を EXCEL等の VBA で事前バインディングするなら Microsoft Scripting Runtime を参照設定します。

この仕掛けにより、クライアントＰＣの保守がとてもラクになります。ＰＣ設定を手作業でおこなう代わりに、スクリプト（Startup_hogehoge.vbs）にしたいことをコーディングすれば良いのです。

◆道具５◆　ＺＩＰファイルを解凍する

VBScript における ZIP ファイルの解凍は、解凍ソフト Lhaplus を利用すると簡単です。

      ' C:\Temp\WWWLOG.1.zip を C:\Log に解凍する
      Set objShell = WScript.CreateObject ("WSCript.shell")
      objShell.Run """C:\Program Files\Lhaplus\Lhaplus.exe"" /o:C:\Log C:\Temp\WWWLOG.1.zip", 1, True
      Set objShell = Nothing

(2010/09/17 追記)
Windows Server 2008 R2 でも Lhaplus が動作しました。プログラムのパスだけ「\Program Files (x86)」に修正しました。

◆道具４◆　レンタルＷｅｂサーバーから生ログをダウンロードする

まず、メモ帳などで FTP コマンドのファイル（Ftp_hogehoge.txt）を作ります。
FTP ユーザ名とパスワードが入っているのがリスクとなります。ご注意ください。
      open ftp.hogehoge.jp
      user0000    ････FTP ユーザ名
      hogehoge    ････パスワード
      ascii       ････転送モード
      get /www/cgi-bin/accesscount.dat c:\Temp\AccessCount.dat
      binary
      get /WWWLOG.1.zip c:\Temp\WWWLOG.1.zip
      get /WWWLOG.2.zip c:\Temp\WWWLOG.2.zip
      get /WWWLOG.3.zip c:\Temp\WWWLOG.3.zip
      get /WWWLOG.4.zip c:\Temp\WWWLOG.4.zip
      get /WWWLOG.5.zip c:\Temp\WWWLOG.5.zip
      get /WWWLOG.6.zip c:\Temp\WWWLOG.6.zip
      get /WWWLOG.7.zip c:\Temp\WWWLOG.7.zip
      quit
accesscount.dat はアクセスカウンタの数値で、WWWLOG.1.zip などが前７日間の生ログです。

実際にコマンドプロンプトで期待どおりの結果が得られることを確認しておきましょう。

VBScript は次のように記述します。
      ' ＦＴＰのコマンドを実行
      Set objShell = WScript.CreateObject ("WSCript.shell")
      objShell.Run "cmd.exe /c ftp -s:c:\Temp\Ftp_hogehoge.txt", 1, True
      Set objShell = Nothing

(2010/10/14 追記)
Windows Server 2008 および 2008 R2 では「セキュリティが強化された Windows ファイアウォール」のため、そのままでは FTP での受信ができません。FTP の標準ポートである 21 番を開け、パッシブモードの場合はさらに 1024 〜 65535 番ポートも ftp.exe だけ許可するように開けてください。

◆道具３◆　SQL Server 2005 Express でバックアップを自動化する

SQL Server 2005 Express には SQL Server Agent サービスが付属していないので、データベースを完全バックアップする VBScript を作り、タスクスケジューラに登録します。

まず、バックアップのクエリファイル（backup_hogehoge.sql）を作ります。バックアップ先はインストール先と違うドライブにしましょう。
      /* master のバックアップ */
      BACKUP DATABASE [master] TO DISK = N'D:\SqlBackup\Master_Backup.BAK' WITH INIT, NOUNLOAD, NAME = N'master バックアップ', NOSKIP, STATS = 10, NOFORMAT
      /* model のバックアップ */
      BACKUP DATABASE [model] TO DISK = N'D:\SqlBackup\Model_Backup.BAK' WITH INIT, NOUNLOAD, NAME = N'model バックアップ', NOSKIP, STATS = 10, NOFORMAT
      /* msdb のバックアップ */
      BACKUP DATABASE [msdb] TO DISK = N'D:\SqlBackup\Msdb_Backup.BAK' WITH INIT, NOUNLOAD, NAME = N'msdb バックアップ', NOSKIP, STATS = 10, NOFORMAT
      /* hogehoge1 のバックアップ */
      BACKUP DATABASE [hogehoge1] TO DISK = N'D:\SqlBackup\hogehoge1_Backup.BAK' WITH INIT, NOUNLOAD, NAME = N'hogehoge1 バックアップ', NOSKIP, STATS = 10, NOFORMAT
      ････以下、データベースのすべてをバックアップします

このクエリファイルを実行する VBScript（SQL2005_FullBackup.vbs）を作ります。
Sqlcmd.exe の起動には -m オプションをつけます。これによりエラーがあればエラー内容が指定のファイルに書き込まれるので、バックアップに成功したかどうかを確認できます。
      ' Windows 認証。管理者権限がないと失敗
      Set objShell = WScript.CreateObject ("WSCript.shell")
      objShell.Run "sqlcmd -S (local) -E -i D:\SqlBackup\backup_hogehoge.sql -m10 -o D:\SqlBackup\SqlcmdResult.txt", 7, True
      Set objShell = Nothing
      ' バックアップ結果のチェック
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objFile = objFSO.GetFile("D:\SqlBackup\SqlcmdResult.txt")
      If (objFile.Size = 0) Then
         varPrompt = WScript.ScriptName & " が正常終了"
         Set objShell = WScript.CreateObject ("WSCript.shell")
         objShell.LogEvent 4, varPrompt
         Set objShell = Nothing
      Else
         Set objTextS = objFile.OpenAsTextStream(1)
         varPrompt = WScript.ScriptName & " でエラー" & vbCrLf & vbCrLf & objTextS.ReadAll
         Set objTextS = Nothing
         Set objShell = WScript.CreateObject ("WSCript.shell")
         objShell.LogEvent 1, varPrompt
         Set objShell = Nothing
      End If
      Set objFile = Nothing
      Set objFSO = Nothing

この VBScript を１時間ごとに実行するようタスクスケジューラに登録すればできあがりです。
なお、データベースが単純復旧モデルであればこれだけでよいのですが、完全復旧モデルの場合はトランザクションログの定期的なバックアップが必要です。さもないとトランザクションログの容量がどんどんどんどん増えて、たいへん困った事態になります。(^^;;

また、いつデータベースがこけても困らないように、必ずデータベースの復旧方法を実際に試しておくことをお勧めします。これについては「道具10」を参照してください。

(2011/08/10 追記)
SQL Server 2008 Express （R2 ではない）でも上記スクリプトを動作確認しました。なんの修正も必要ありませんでした。
ただ、SQL Server 2008 Express （R2 ではない）では既定のインスタンスでインストールする方法がわかりにくいので、既定のインスタンスでインストールできなかった方もいらっしゃるのでは････。
互換のためには既定のインスタンスでインストールする必要がありますが、互換が必要なければ名前付きインスタンス（既定値 SQLEXPRESS）でもかまいません。
既定のインスタンスの場合にはインスタンス名を省略して「サーバー名」だけか「 (local) 」ですが、名前付きインスタンスの場合は「サーバー名\インスタンス名」になりますから、上記のスクリプトなども修正が必要となり、互換性がなくなるわけです。

◆道具２◆　SQL Server のデタッチとアタッチ

SQL Server 2000 から SQL Server 2005 にデータベースを移行するときのデタッチとアタッチは次の手順で。

デタッチするクエリファイル（detach_hogehoge.sql）を作成します。
      USE master;
      EXEC sp_detach_db @dbname = N'hogehoge1';
      EXEC sp_detach_db @dbname = N'hogehoge2';
      ････以下、ユーザデータベースのすべてをデタッチします

アタッチするクエリファイル（attach_hogehoge.sql）を作成します。
     USE master;
     CREATE DATABASE hogehoge1 ON PRIMARY
       (FILENAME = 'C:\Program Files\Microsoft SQL Server\MSSQL.1\MSSQL\Data\hogehoge1.mdf')
       LOG ON (FILENAME = 'C:\Program Files\Microsoft SQLServer\MSSQL.1\MSSQL\Data\hogehoge1.ldf')
         FOR ATTACH;
      ････以下、デタッチしたデータベースのすべてをアタッチします

さて実行です。
デタッチは SQL Server 2000 側で、クエリアナライザで開いて実行するか、またはコマンドプロンプトから sqlcmd で実行します。
      sqlcmd -S (local) -E -i C:\temp\detach_hogehoge.sql
          ※Windows 認証で、管理者権限が必要
SQL Server 2000 側でデタッチしたデータベースの ldf ファイルと mdf ファイルを、SQL Server 2005 側の Data フォルダ（アタッチの FILENAME = と一致するはず）にコピーします。
SQL Server 2005 側で Management Studio Express でアタッチのクエリファイルを実行します。

ここで、必ずしもクエリファイルを作成する必要はないわけですが、作ったほうが安全確実です。

なお、msdn では「アップグレードされたデータベースで DBCC UPDATEUSAGE を実行することをお勧めします」とされていますから、次のようなクエリファイルを作成しておき、実行します。
      USE hogehoge1;
      DBCC UPDATEUSAGE (hogehoge1)
      ････以下、ユーザデータベースのすべてを DBCC UPDATEUSAGE します

また、SQL Server 2000 側でまだ運用する場合は、再アタッチして使用できるようにしなければなりません。これには sp_attach_db を使用します。これもクエリファイルにしておきましょう。
     USE master;
     EXEC sp_attach_db @dbname = N'hogehoge1',
          @filename1 = N'C:\Program Files\Microsoft SQL Server\MSSQL\Data\hogehoge1.mdf',
          @filename2 = N'C:\Program Files\Microsoft SQL Server\MSSQL\Data\hogehoge1.ldf';
      ････以下、ユーザデータベースのすべてをアタッチします

クエリの実行でエラーが発生しませんでしたか？　DB アプリケーションで使用している ldf ファイルと mdf ファイルのパスが違っていた、なんていうことがないように････(^^;;。

さて、うまくいったかどうかを SQL Server 2005 側の Management Studio Express で確認しましょう。

あとは、クライアントから接続できる環境にします。SQL Server 構成マネージャの MSSQLSERVER のプロトコルで TCP/IP を有効にします(サービスの再起動で有効です)。

(2010/10/14 追記)
Windows Server 2008 および 2008 R2 では「セキュリティが強化された Windows ファイアウォール」のため、そのままではクライアントから接続できません。マイクロソフトの Web サイトに「Windows Server 2008 で SQL Server のファイアウォールポートを開く方法」(http://support.microsoft.com/kb/968872/ja)がありますから参照してください。

(2011/08/10 追記)
まだ本番機は SQL Server 2000 のままです。
このため SQL Server 2008 Express （R2 ではない）へのアップグレードも検証しましたが、特に問題はありませんでした。
既定のインスタンスでのインストールと、Data フォルダのパスに注意することくらいですね。

(2011/12/06 追記)
11月に本番機を SQL Server 2008 Express （R2 ではない）に更新しました。
更新作業はまったく問題なかったのですが、SQL Server 2008 Express （R2 ではない）の振る舞いにより一部アプリケーションで不具合が生じましたので、ご注意ください。
例えば、テラソフトデザインの帳票ソフト Wonderful Report 2000 で作成した一部帳票が乱れる現象があり、データソースであるビューの Order By 句が無視されることが原因でした。
詳しくはマイクロソフトの Web サイト「[FIX] SQL Server 2008 で ORDER BY 句を使用したビューを使用してクエリを実行しても結果がランダムな順序で返される」(http://support.microsoft.com/kb/926292)を参照してください。

◆道具１◆　ＬＡＮ内のＰＣにメッセージを送る

ＬＡＮ内のＰＣにメッセージを送るには、MS-DOS コマンドの net send を使用します。ただし、Windows Vista などでは対応していないようです。
簡単なメッセージしか送ることができませんが、有効利用しましょう。
例えば、VBScript の処理中にエラーなどのメッセージを管理ＰＣに送るときに使用します。

      Set objShell = WScript.CreateObject ("WSCript.shell")
      objShell.Run "cmd.exe /c net send hogehoge " & "送りたいメッセージ"
      Set objShell = Nothing

単純にメッセージを送るだけなら、例えば

      net send /domain "昼休み（12時30分ごろから）に停電します。ご注意ください"

と記述したバッチファイル(hogehoge.bat)を作成して、サーバーで指定日時に実行するようにします。

送る側と受ける側のＰＣの双方で Messenger サービスが起動されている必要があります。気がついたらメッセージが届かなくなっていて、それがＯＳの再インストールのせいだったなんてことがないように注意しましょう。（^_^;;
また、受ける側のファイアーウォールも影響します。
うまくいくかどうかを必ずコマンドプロンプトで試しておきましょう。

なお、WSCript.shell を EXCEL等の VBA で事前バインディングするなら Windows Script Host Object Model を参照設定します。
    Dim objShell As WshShell
    Set objShell = New WshShell
      objShell.Run "cmd.exe /c net send hogehoge " & "送りたいメッセージ"

(2010/09/17 追記)
送る側のＰＣで net send が使えない場合は、代わりに msg.exe を使用します。
net send の /domain のような指定がないなどの不都合があります。

      objShell.Run "cmd.exe /c msg.exe * /server:hogehoge " & "送りたいメッセージ"

なお、msg.exe で「セッション名の取得エラー５」になる場合の対処方法は道具23を参照してください。

このページの先頭へ

お気軽にお問い合わせください

〒438-0086
静岡県磐田市見付2753番地2
TEL 0538-32-4105
FAX 0538-37-5075
E-mail webguest@iwatax.jp

税理士法人イワタックスは、静岡県西部地区(磐田市・浜松市・袋井市・森町・掛川市)で地域No.1を目指す会計事務所です

ITの道具箱

◆閑話休題 (11)◆ Windows 8 Pro をクリーン・インストールしてみる

◆閑話休題 (10)◆ EXCEL 2010 の 2003 との互換性

◆閑話休題 (9)◆ Sysprep でイメージ展開するとログオフに時間がかかる

◆道具28◆ サイトに最新のドライバがないかチェックする

◆閑話休題 (8)◆ POP before SMTP のためにメールが送れないので・・・・

◆閑話休題 (7)◆ Windows の設定はたいへんです

◆道具27◆ PsExec.exe でクライアントＰＣからサーバーのシャットダウンを指示する

◆閑話休題 (6)◆ VBScript で引数を受け取る

◆閑話休題 (4)◆ VBScript の Option Explicit と On Error Resume Next での怖い話

◆道具26◆ プログラムのバージョンをチェックしてアップデートを起動する

◆道具25◆ VBScript でデバイスの有効と無効を制御する

◆道具24◆ SQL Server のコンピュータ名を変更する

◆閑話休題 (3)◆ AHCI の PC に Windows XP をインストールする

◆閑話休題 (1)◆ EXCEL VBA のプログラミングではセルに名前をつけましょう

◆道具21◆ パラメータマーカーを使用して動的ＳＱＬ

◆道具20◆ サービスを無効にする

◆道具19◆ ネットワークアダプタの TCP/IP のプロパティを設定する

◆道具18◆ ネットワークアダプタの TCP/IP のプロパティを取得する

◆道具17◆ リコー複合機と SNMP で通信する

◆道具15◆ 開いているファイルをチェックする

◆道具14◆ イベントログをチェックする

◆道具13◆ SQL Server でテーブル定義を取得する

◆道具12◆ Windows 認証で SQL Server に接続する

◆道具11◆ ファイルの更新日時を変更する

◆道具10◆ SQL Server データベースの復旧

◆道具９◆ 最適化する

◆道具８◆ プリンタを削除する

◆道具７◆ 通常使うプリンタを設定する

◆道具６◆ クライアントＰＣの電源投入時に最新のスクリプトを実行させる

◆道具４◆ レンタルＷｅｂサーバーから生ログをダウンロードする

◆道具１◆ ＬＡＮ内のＰＣにメッセージを送る

ナビゲーション