Office TANAKA - Excel VBA Tips[拡張子を判定する方法]

ネットで公開されましたので安心して書きますが(^^;
次期オフィスはXMLが標準ファイル形式となるようです。詳しいニュースは下記をご覧ください。
■Office 12ではExcel、Word、PowerPointのファイルがXMLベースに:ニュース - CNET Japan

まぁ、XMLの是非について、ここではあえて書きませんけど、気になるのは次の部分です。

新フォーマットのファイル拡張子には、Microsoftの既存の表記方法に「x」の文字が付加される。
たとえば、Wordで作成したドキュメントにはファイル名に「.docx」の拡張子が付くことになる。

Excelの一般的なブックは、今まで拡張子がxlsでした。記事の通りなら、次期オフィスからはxlsxとなるそうです。
みなさん、大丈夫ですか？(^_^;

マクロでブックを選択するような処理で、ファイル名の後ろ3文字を見て「ブックかどうか」を判定しているコードは全滅ですよ。
たとえば、次のようなコードは×です。

Sub Sample1()
    Dim Target As String
    Target = Application.GetOpenFilename()
    If Right(Target, 3) = "xls" Then
        ''Targetに対する処理
    Else
        MsgBox "Excelのブックを選択してください。", 48
    End If
End Sub

ちなみに、上記のコードも確実ではありません。拡張子がXLSと大文字だった場合は、ブックと認識されないからです。
できれば、LCase(Right(Target, 3)) <> "xls"　または、UCase(Right(Target, 3)) <> "XLS"　のように、ファイル名を小文字または大文字に変換してから判定してください。

さて、拡張子がxlsxになったらどうしましょう。
すぐ思いつくのは、ピリオドの位置を調べて、そこから後ろを抜き出して判定する方法です。
このとき、ピリオドの位置を先頭から調べてはいけません。Book1.test.xls　みたいなファイルもあり得るからです。
ピリオドの位置を後ろから見つけて判定するには次のようにします。

Sub Sample2()
    Dim Target As String, pos As Long
    Target = Application.GetOpenFilename()
    pos = InStrRev(Target, ".")
    If pos > 0 Then
        If LCase(Mid(Target, pos + 1)) = "xlsx" Then
            ''Targetに対する処理
        Else
            MsgBox "Excelのブックを選択してください。", 48
        End If
    End If
End Sub

文字列の中に、任意の文字が含まれるかどうかはInStr関数で判定します。
InStr関数についての詳しい解説は「データが含まれているかどうか判定する」をご覧ください。

ただし、InStr関数は文字列を先頭から調べる関数です。同じ機能で、文字列を後ろから調べてくれるのが、InStrRev関数です。
ファイルには拡張子がないものもありますから、pos > 0　と見つからなかったときの処理も入れておきましょう。
最後のピリオドが何文字目かを取得したら、そこから後ろをMid関数で抜き出します。

ただ、これでは安心できません。
おそらくユーザーのディスクには、拡張子xlsのブックと拡張子xlsxのブックが混在するでしょう。
Webページのファイルが、htmやhtmlだったりするのと同じですね。xlsとxlsxを両方同じように判定するには、文字数を決め打ちできません。
いろんな方法が考えられますが、とりあえず2種類の拡張子をOr演算子で判定してみましょうか。

Sub Sample3()
    Dim Target As String, pos As Long
    Target = Application.GetOpenFilename()
    pos = InStrRev(Target, ".")
    If pos > 0 Then
        If LCase(Mid(Target, pos + 1)) = "xls" Or _
           LCase(Mid(Target, pos + 1)) = "xlsx" Then
            ''Targetに対する処理
        Else
            MsgBox "Excelのブックを選択してください。", 48
        End If
    End If
End Sub

あるいは、Like演算子でもできますね。Like演算子についての詳しい解説は「正規表現のようなマッチング」をご覧ください。

Sub Sample4()
    Dim Target As String, pos As Long
    Target = Application.GetOpenFilename()
    pos = InStrRev(Target, ".")
    If pos > 0 Then
        If LCase(Mid(Target, pos + 1)) Like "xls*" Then
            ''Targetに対する処理
        Else
            MsgBox "Excelのブックを選択してください。", 48
        End If
    End If
End Sub

ただ、これだと「xls123」みたいな変な拡張子もマッチしちゃいますから、注意してください。

また、拡張子を取得するには、FileSystemObjectオブジェクトを使う手もあります。
FileSystemObjectオブジェクトについての詳しい解説は「FileSystemObjectとは」をご覧ください。

Sub Sample5()
    Dim Target As String
    Target = Application.GetOpenFilename()
    With CreateObject("Scripting.FileSystemObject")
        If LCase(.GetExtensionName(Target)) = "xls" Or _
           LCase(.GetExtensionName(Target)) = "xlsx" Then
            ''Targetに対する処理
        Else
            MsgBox "Excelのブックを選択してください。", 48
        End If
    End With
End Sub

あるいは、どうせFileSystemObjectオブジェクトを使うのなら、もっとカッコイイ方法もあります。
拡張子を判定する目的は、そのファイルがExcelのデータファイルかどうかを調べたいんですよね。
FileSystemObjectオブジェクトには、ファイルのタイプを返すプロパティもあったりします。

Sub Sample6()
    Dim Target As String
    Target = Application.GetOpenFilename()
    With CreateObject("Scripting.FileSystemObject")
        If .GetFile(Target).Type = "Microsoft Excel ワークシート" Then
            ''Targetに対する処理
        Else
            MsgBox "Excelのブックを選択してください。", 48
        End If
    End With
End Sub

今はまだ、Excelが出力した正規のxlsxファイルでテストできませんが、理屈ではこれでOKのはずです。

さぁ、来年の次期オフィスにそなえて、マクロを見直しておきましょう。
え？誰ですか？「どうせ、バージョンアップしないから関係ないよ…」なんて言う人は？(^^;;