VBAのDir()関数のワイルドカードの誤動作を補正する。

If Like で補正します。

Dim File As String
Dim Folder As String
Dim Pattern1 As String
Dim Pattern2 As String
Folder = "c:\windows\system32"
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
Pattern1 = "*.txt"
Pattern2 = Replace(Replace(Pattern1, "[", "[[]"), "#", "[#]")
File = Dir(Folder & Pattern1)
Do While Len(File)
  If File Like Pattern2 Then
    Debug.Print File
  Else
    Debug.Print "!", File
  End If
  File = Dir()
Loop

.NETのDirectory.GetFiles(,検索パターン)の代替関数

ワイルドカードの誤動作を補正する代替関数です。

Function GetFiles(Folder As String, Pattern As String) As String()
Dim Files As String() = Directory.GetFiles(Folder,Pattern)
Dim Pattern2 As String = Replace(Replace(Pattern,"[","[[]"),"#","[#]")
Dim n As Integer = -1
For k As Integer = 0 To Files.Length-1
  If Path.GetFileName(Files(k)) Like Pattern2 Then
    n+=1
    Files(n)=Files(k)
  End If
Next
ReDim Preserve Files(n)
Return Files
End Function

.NETのDirectory.GetFiles(,検索パターン)のワイルドカードの誤動作に注意すべし。

*1.* や *2.* などは、長いファイル名にも、よくマッチします。
*.xls は、*.xlsx や *.xlsm などにもマッチします。つまり、*.xls* みたい。正確には違いますが。

このことはヘルプにも一部書いてあります。
Directory.GetFiles メソッド (String, String) (System.IO)
http://msdn2.microsoft.com/ja-jp/library/wz42302f(VS.80,printer).aspx

短いファイル名にマッチすると、長いファイル名を返す。のが仕様のようです。というか、そもそも、それが、FindFirstFile() APIの仕様です。
GetShortPathName
http://msdn.microsoft.com/library/ja/jpfileio/html/_win32_getshortpathname.asp?frame=true

なので、自分で再度、検索パターンでフィルタリングする必要があります。
If Path.GetFileName(パス) Like 検索パターン Then

かと言って、Directory.GetFiles(,検索パターン)を使わず、全件検索して最初から自分で検索パターンでフィルタリングするのは、遅いのでやめましょう。
面倒でも、二重にフィルタリングしましょう。

ただし、GetFiles(,検索パターン1) と Like 検索パターン2 でシンタクスが少し違うので、
検索パターン2=Replace(Replace(検索パターン1,"[","[[]"),"#","[#]")
でエスケープする必要があります。

.NETでファイルを検索するときは、Directory.GetFiles(,検索パターン)を積極的に使うべし。

DBでもそうですが、「全件検索を避ける」のが鉄則です。

複数パターンの場合は、
複数回、Directory.GetFiles(,検索パターン)する。
全件検索して、その結果から自分で複数パターンでフィルタリングする。
では、どちらが速いか？

前者のほうが、後者より、一般的に速い。

また、一般的に、
IO処理よりメモリ処理が速い。
IO処理を繰り返すと遅くなる。
などの「一般常識」は、疑ってかかったほうがよいでしょう。

場合により、IO処理はメモリ処理(キャッシュ)に化け、メモリ処理はIO処理(ページング)に化けます。

塵も積もれば山となるで、速いはずのメモリ処理も数が多いと遅くなります。

WScriptオブジェクトの簡単ラッパーオブジェクト

WScript.exeやCScript.exeのWScriptオブジェクトをVBやVBAから使うには、そのラッパオブジェクトを作ればよいのです。
まぁそこまでしなくても、手抜きのラッパーオブジェクト擬似なら簡単です。

WScript.VBS
---
Do While Not WScript.StdIn.AtEndOfStream
  Execute WScript.StdIn.ReadLine
Loop
---

WScript.exeを使うには、

Set wShell=CreateObject("WScript.Shell")
Set oExec=wShell.Exec("WScript.exe WScript.VBS")
oExec.StdIn.WriteLine "WScript.Echo 5000"
oExec.StdIn.WriteLine "WScript.Sleep 5000"
oExec.StdIn.WriteLine "WScript.Echo 5000"
oExec.StdIn.Close

CScript.exeを使うには、

Set wShell=CreateObject("WScript.Shell")
Set oExec=wShell.Exec("CMD /C CScript.exe WScript.VBS >CON")
oExec.StdIn.WriteLine "WScript.Echo 5000"
oExec.StdIn.WriteLine "WScript.Sleep 5000"
oExec.StdIn.WriteLine "MsgBox 5000"
oExec.StdIn.Close

IsEmpty() などは使わないこと。

ヘルプには以下のように書いてありますが、これを真に受けてはいけません。

---
IsEmpty 関数
変数が初期化されたかどうかを調べ、結果をブール値で返します。

解説
IsEmpty 関数は、指定した変数が初期化されていない場合、または、Empty 値の場合は、真 (True) を返します。
---

IsEmpty(varname) の実装は、(VarType(varname)=vbEmpty) のようで、実際には、objectが既定プロパティを持つとき、IsEmpty(object) はその既定プロパティがEmpty かどうかを返すようです。

これは障害だと思いますが、詮無きことなので、もし、varname を評価したければ（普通はそうですが）、

Function IsEmpty2(varname)
  If IsObject(varname) Then
    IsEmpty2=False
  Else
    IsEmpty2=IsEmpty(varname)
  End If
End Function

のように代替します。

しかし、それよりも、なによりも、( TypeName(varname)="Empty" ) を使ったほうが簡単です。

なので、原則、IsEmpty() は使わないで、TypeName() を使いましょう。

もし、varname がオブジェクトでないことが明白なら、IsEmpty() を使うことに問題はありません。

IsObject()を除く他のIs???()も同様です。

TypeName() と VarType() の違いに注意。

TypeName(varname) は文字列を返し、VarType(varname) は数値を返すだけの違い？と思っていたら大間違い。

varname の評価の仕方が異なる、全くの別物です。

TypeName(varname) は varname を評価し、VarType(varname) は、もし varname がオブジェクトで既定のプロパティがあれば、それを評価します。

VarType() のヘルプを見ると、確かに、そういう記述があります。
objectが既定プロパティを持つとき、VarType(object) はその既定プロパティの型を返します。

これは欠陥仕様だと思いますが、詮無きことなので、もし、varname を評価したければ（普通はそうですが）、

Function VarType2(varname)
  If IsObject(varname) Then
    VarType2=vbObject
    If IsArray(varname) Then VarType2=VarType2 Or vbArray
  Else
    VarType2=VarType(varname)
  End If
End Function

のように代替します。

しかし、それよりも、なによりも、TypeName() を使ったほうが簡単です。

なので、原則、VarType() は使わないで、TypeName() を使いましょう。

もし、varname がオブジェクトでないことが明白なら、VarType() を使うことに問題はありません。

ファイル名に=;,や全角空白を含むファイルをバッチファイルにドロップすると、ファイル名が分割される。(その３)

関連付けでなく、個々のバッチファイル側で回避することもできます。

@if(0)==(0) ECHO OFF
SET ARGS=%*
SETLOCAL ENABLEDELAYEDEXPANSION
FOR /F "delims=" %%a IN ('CScript.exe //NoLogo //E:JScript "%~f0" !ARGS!') DO (
ENDLOCAL
CALL :SUB %%a
)
GOTO :EOF
:SUB
ECHO ここから
ECHO %%1=%1
ECHO %%2=%2
ECHO %%3=%3
ECHO ここまでに元のバッチファイルを入れます。
GOTO :EOF
@end
var args=new Array();
for(var k=0;k<WScript.Arguments.Count();k++){
var arg=WScript.Arguments.Item(k);
args.push(arg.search(/[  =;,　]/)+1?'"'+arg+'"':arg);}
WScript.Echo(args.join(' '));

※2013-06-29修正。読者指摘により、ファイル名に!を含むケースに対応。

ファイル名に=;,や全角空白を含むファイルをバッチファイルにドロップすると、ファイル名が分割される。(その２)

別の回避策は、以下のバッチファイルをバッチファイルに関連付けます。

"フルパス\CMD.CMD" "%1" %*

@if(0)==(0) ECHO OFF
SET ARGS=%*
SETLOCAL ENABLEDELAYEDEXPANSION
FOR /F "delims=" %%a IN ('CScript.exe //NoLogo //E:JScript "%~f0" !ARGS!') DO (
ENDLOCAL
%%a
)
GOTO :EOF
@end
var args=new Array();
for(var k=0;k<WScript.Arguments.Count();k++){
var arg=WScript.Arguments.Item(k);
args.push(arg.search(/[  =;,　]/)+1?'"'+arg+'"':arg);}
WScript.Echo(args.join(' '));

※2013-06-29修正。読者指摘により、ファイル名に!を含むケースに対応。

ファイル名に=;,や全角空白を含むファイルをバッチファイルにドロップすると、ファイル名が分割される。

以下のバッチファイルで現象が再現できます。

call :sub a　b=c;d,e
goto :eof
:sub
echo 1=%1
echo 2=%2
echo 3=%3
echo 4=%4
echo 5=%5
echo 6=%6

参考記事:「ファイル名に=;,や全角空白を使うときは、半角空白も併せて使うべし。」
http://scripting.cocolog-nifty.com/blog/2008/02/post_c740.html

回避策も、参考記事のとおりですが、他に、以下のスクリプトをバッチファイルに関連付ける方法があります。

CScript.exe "フルパス\CMD.VBS" "%1" %*

Option Explicit
Dim wShell
Dim Args
Dim Arg
Dim oExec

Set wShell=CreateObject("WScript.Shell")
Args=Array("CMD.EXE /C <CON 2>&1")
For Each Arg In WScript.Arguments
  If InStr(Arg," ") + InStr(Arg,"　") Then Arg="""" & Arg & """"
  ReDim Preserve Args(UBound(Args)+1)
  Args(UBound(Args))=Arg
Next
Set oExec=wShell.Exec(Join(Args," "))
Do While Not oExec.StdOut.AtEndOfStream
  WScript.StdOut.Write oExec.StdOut.Read(1)
Loop
Do While oExec.Status=0
  WScript.Sleep 100
Loop
WScript.Quit oExec.ExitCode

VBScriptからmax()やmin()などのJScriptのMathオブジェクトのメソッドやプロパティを使う。

JScriptには、max()やmin()などがあります。が、VBScriptにはありません。
なくても特に困りませんが、どうしても使いたければ使えます。

Set SC=CreateObject("ScriptControl")
SC.Language="JScript"
MsgBox SC.CodeObject.Math.max(1,2,3)

プロパティ
E プロパティ | LN2 プロパティ | LN10 プロパティ | LOG2E プロパティ | LOG10E プロパティ | PI プロパティ | SQRT1_2 プロパティ | SQRT2 プロパティ

メソッド
abs メソッド | acos メソッド | asin メソッド | atan メソッド | atan2 メソッド | ceil メソッド | cos メソッド | exp メソッド | floor メソッド | log メソッド | max メソッド | min メソッド | pow メソッド | random メソッド | round メソッド | sin メソッド | sqrt メソッド | tan メソッド

そのディレクトリ以下のすべてのファイルをそのディレクトリに移動する。

最上位へ移動.CMD フォルダ

@IF '%1'=='' (
ECHO Usage: %~nx0 TopDir
) ELSE (
FOR /R %1 %%1 IN (*) DO MOVE /-Y "%%1" %1\
)

DEL *.XLS は危険です！

拡張子３文字指定のワイルドカードは危険です！

例えば、Excelファイル群の中から .xls ファイルだけを消そうと、
del *.xls
すると、
*.xlsb
*.xlsm
*.xlsx
などもすべて消えます。わおーっ！

CMD.EXEのワイルドカードでは、*.xls が、実は *.xls でなく、*.xls* と同じです。

例えば、
dir /b *.xls
や
for %i in (*.xls) do @echo %i
は、
*.xls
だけでなく
*.xlsb
*.xlsm
*.xlsx
なども拾います。

なので、対策としては、２重に絞り込みます。
１段目は緩く *.* にして、２段目だけで絞り込んでも可。

dir /b *.xls|findstr /i "\.xls$"
for /f "delims=" %i in ('dir /b *.xls^|findstr /i "\.xls$"') do @echo %i
for %i in (*.xls) do @if /i %~xi==.xls echo %i

findstr は、正規表現なので、ワイルドカードとのシンタクスの違いに注意。
また、if で判定するときは、ケース無依存にすることに注意。

参考:Dirコマンド
http://technet2.microsoft.com/WindowsServer/ja/library/a6aaf662-4153-4f8c-873e-58d91aedc1ea1041.mspx

そのExcelファイルが開かれているか？をVBAから調べる。

Application.Workbooksで分かるのは、そのExcel.Applicationで開かれているExcelファイルだけです。
そこで、

Dim Path As String
Dim Count As Long
Dim Book As Variant

Path="Excelファイルのフルパス"
Count = Application.Workbooks.Count
Set Book = GetObject(Path)
If Count <> Application.Workbooks.Count Then
  Book.Close
  Set Book = Nothing
  MsgBox "Not Open"
ElseIf Book.Application Is Application Then
  MsgBox "Open here"
Else
  MsgBox "Open elsewhere"
End If

そのExcelファイルが開かれているか？をスクリプトから調べる。

Excel.Applicationが動いているか？は、GetObject(,"Excel.Application")で分かります。
しかし、Excelファイルが開かれているか？は、GetObject("Excelファイル")では分かりません。

あるExcel.Applicationで、そのExcelファイルが開かれているか？は、Application.Workbooksで分かります。
しかし、GetObject(,"Excel.Application")では、Excel.Applicationを列挙することができません。

Path="Excelファイルのフルパス"
On Error Resume Next
Set Application=GetObject(,"Excel.Application")
On Error GoTo 0
If IsEmpty(Application) Then
  MsgBox "No App"
Else
  Count=Application.Workbooks.Count
  Set Book1=GetObject(Path)
  If Count<>Application.Workbooks.Count Then
    MsgBox "Not Open"
  ElseIf Book1.Application Is Application Then
    MsgBox "Open here"
  Else
    MsgBox "Open elsewhere"
  End If
End If

Excel VBAから他のExcelインスタンスを捕捉する。

Excel VBAから他のExcelインスタンスを捕捉する。

Option Explicit

Function GetOtherApplications()
Dim Path As String
Dim Applications As Variant
Dim Application2 As Object
Dim Count1 As Long
Dim Count2 As Long
Dim channelNumber As Long
Dim x As Variant

Applications = Array()
Count1 = GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count
Do
  Application.DisplayAlerts = False
  channelNumber = Application.DDEInitiate("Excel", "System")
  Application.DisplayAlerts = True
  Application.DDEExecute channelNumber, "[NEW()]"
  x = Application.DDERequest(channelNumber, "Topics")
  Path = x(UBound(x) - 1)
  Path = Split(Mid(Path, 2), "]")(0)
  Set Application2 = GetObject(Path).Application
  Application.DDEExecute channelNumber, "[CLOSE()]"
  Application.DDETerminate channelNumber
  Count2 = GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count
  If Count2 <> Count1 Then
    Application2.Quit
    Set Application2 = Nothing
    Exit Do
  End If
  ReDim Preserve Applications(UBound(Applications) + 1)
  Set Applications(UBound(Applications)) = Application2
  Application2.IgnoreRemoteRequests = True
Loop
For Count1 = 0 To UBound(Applications)
  Applications(Count1).IgnoreRemoteRequests = False
Next
GetOtherApplications = Applications
End Function

Sub sample()
MsgBox UBound(GetOtherApplications()) + 1
End Sub

配列 Applications() に実行中の他の Excel.Application オブジェクトへの参照が入ります。

実行中の複数のExcelインスタンスをスクリプトから捕捉する。

えー！ そんなことできるの？ という感じですが。。。

Sub Push(Items,Item)
ReDim Preserve Items(UBound(Items)+1)
Set Items(UBound(Items))=Item
End Sub

Applications=Array()
On Error Resume Next
Set Application1=GetObject(,"Excel.Application")
On Error GoTo 0
If Not IsEmpty(Application1) Then
  Count1=GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count
  Push Applications,Application1
  Application1.IgnoreRemoteRequests=True
  Do
    Application1.DisplayAlerts=False
    channelNumber=Application1.DDEInitiate("Excel","System")
    Application1.DisplayAlerts=True
    Application1.DDEExecute channelNumber,"[NEW()]"
    x=Application1.DDERequest(channelNumber,"Topics")
    Path=x(UBound(x)-1)
    Path=Split(Mid(Path,2),"]")(0)
    Set Application2=GetObject(Path).Application
    Application1.DDEExecute channelNumber,"[CLOSE()]"
    Application1.DDETerminate channelNumber
    Count2=GetObject("winmgmts:root\CIMV2").ExecQuery("SELECT * FROM Win32_Process WHERE Name='EXCEL.EXE'").Count
    If Count2 <> Count1 Then
      Application2.Quit
      Set Application2 = Nothing
      Exit Do
    End If
    Push Applications,Application2
    Application2.IgnoreRemoteRequests=True
  Loop
  For Each Application In Applications
    Application.IgnoreRemoteRequests=False
  Next
End If
MsgBox UBound(Applications)+1

配列 Applications() に実行中の Excel.Application オブジェクトへの参照が入ります。