Like演算子で、[と]を文字として扱い比較したい

質問

今、フォルダ内のファイルリストを作成するVBA(Excel2003)を作っています。そこで、ファイル（絶対パス：フルパス）に「含まれていい文字」と「含まれない文字」（キーワード）を指定できる機能を作っています。

以前、VB6で類似の機能を作った時は、すんなり行ったのですが、VBAではうまくいきません。正規表現が使えるに越したことはないのですが、「 [ や ] を文字として認識するだけでもいいです。」

リストを作るフォルダには、
　[20].txt
　テキスト[a]txt
　メモ[10] - コピー.txt
などのテストファイルとその他ファイルが存在します。

キーワードを指定しないときには、うまく行きます。
指定すると、たとえば [10].txt というファイルがヒットしないように、NGワードを [10] を指定すると、[20].txtまでヒットしません。[a]では全てがヒットしません。

また、OKワードに[10]を指定すると[10]と[20]がヒットします。
===== NGワードを比較している部分 ====
引数：in_str が NGワード（スペースで区切って複数指定可能）
引数：target_Str がフルパス

Public Function keywords_NG(in_Str As String, target_Str As String) As Boolean
　　If in_Str = "" Then
　　　　keywords_NG = True
　　　　Exit Function
　　End If

　　Dim wordArray() As String
　　Erase wordArray()
　　wordArray() = Split(in_Str, Space(1))

　　Dim tempFLG As Boolean
　　tempFLG = True

　　Dim wordIDX As Long
　　For wordIDX = 0 To UBound(wordArray) Step 1
　　　　If wordArray(wordIDX) <> "" And target_Str <> "" Then
　　　　　　If target_Str Like "*" & wordArray(wordIDX) & "*" = True Then
　　　　　　　　tempFLG = False
　　　　　　End If
　　　　End If
　　Next
　　If tempFLG = True Then
　　　　keywords_NG = True
　　Else
　　　　keywords_NG = False
　　End If
End Function

===== OKワードを比較している部分 ====

引数：in_Str が OKワード（スペースで区切って複数指定可能）
引数：target_Str がフルパス

Public Function keywords_OK(in_Str As String, target_Str As String) As Boolean
　　If in_Str = "" Then
　　　　keywords_OK = True
　　　　Exit Function
　　End If

　　Dim wordArray() As String
　　Erase wordArray()
　　wordArray() = Split(in_Str, Space(1))

　　Dim tempFLG As Boolean
　　tempFLG = False

　　Dim wordIDX As Long
　　For wordIDX = 0 To UBound(wordArray) Step 1
　　　　If wordArray(wordIDX) <> "" And target_Str <> "" Then
　　　　　　If target_Str Like "*" & wordArray(wordIDX) & "*" = True Then
　　　　　　　　tempFLG = True
　　　　　　End If
　　　　End If
　　Next

　　If tempFLG = True Then
　　　　keywords_OK = True
　　Else
　　　　keywords_OK = False
　　End If

End Function
===== [や]を区切り文字ではなくする関数 ====
Public Function keywords_escape_sequence(keywordStr As String) As String

　　If keywordStr = "" Then
　　　　keywords_escape_sequence = ""
　　　　Exit Function
　　End If

　　Dim myIDX As Currency
　　Dim str_X As String

　　str_X = ""

　　For myIDX = 1 To Len(keywordStr) Step 1
　　　　If Mid(keywordStr, myIDX, 1) = "[" Then
　　　　　　str_X = str_X & "[[]"
　　　　ElseIf Mid(keywordStr, myIDX, 1) = "]" Then
　　　　　　str_X = str_X & "[]]"
　　　　Else
　　　　　　str_X = str_X & Mid(keywordStr, myIDX, 1)
　　　　End If
　　Next

　　keywords_escape_sequence = str_X
End Function

=====================================================
　　　　If keywords_OK(keywords_OK_Str, フルパス)) = True And _
　　　　　　keywords_NG(keywords_NG_Str, フルパス)) = True Then
　　　　　　　　'ファイルリスト作成
　　　　end if
=====================================================

正規表現を使うためには…というページを見つけ参照設定に以下の項目にチェックを入れてみましたが、結果は変わらす

□Microsoft VBScript Regular Expressions 5.5

===== RegExp と CreateObject ====

参照設定をできれば変更したくない場合は、RegExp と CreateObject を使えば良いとあるページに書いてありましたが、参照設定でもできなかったので、これだけは試してません。

ヒントだけでもお教えください。

回答No.1

n-jun · ベストアンサー

Sub try()
Dim RegExp As Object
Dim v(1 To 3) As String
Dim KeyWord As String
Dim i As Integer

Set RegExp = CreateObject("VBScript.RegExp")

v(1) = "[20].txt"
v(2) = "テキスト[a]txt"
v(3) = "メモ [10] - コピー.txt"

KeyWord = "10" 'キーワードは[]の中の数字のみ

RegExp.Pattern = "\[" & KeyWord & "\]"

For i = 1 To 3
If RegExp.Test(v(i)) Then 'キーワードに一致でＯＫ
MsgBox v(i)
End If
Next

MsgBox "チェンジ"

For i = 1 To 3
If Not RegExp.Test(v(i)) Then 'キーワードに不一致でＯＫ
MsgBox v(i)
End If
Next

Set RegExp = Nothing
Erase v

End Sub

勘違いでしたらスル～して下さい。

お礼

メタ文字すべてをエスケープ（？）してみました。

キーワードをセットするボタンに、エラー処理を作りましたが、文字制限のあるので、載せていません。

Public Function keywords_escape_sequence(keywordStr As String) As String

　If keywordStr = "" Then
　　keywords_escape_sequence = ""
　　Exit Function
　End If

　'メタ文字のエスケープはReplace関数を使ったほうがスマートだとは思いますが、自作しました。

　If frmKeywords.cbMetaCharMode.Value = False Then 'メタ文字を単なる文字として扱うモード

　　Dim MetaTagChars As String

　　MetaTagChars = "^$?*+.|{}\[]()" 'メタ文字の一覧 http://codezine.jp/article/detail/1655

　　Dim myIDX As Long

　　Dim str_X As String
　　str_X = ""

　　For myIDX = 1 To Len(keywordStr) Step 1
　　　Dim tagIDX As Long

　　　Dim tagFlg As Boolean

　　　tagFlg = False

　　　For tagIDX = 1 To Len(MetaTagChars) Step 1

　　　　If Mid(keywordStr, myIDX, 1) = Mid(MetaTagChars, tagIDX, 1) Then
　　　　　tagFlg = True
　　　　End If

　　　　If Mid(keywordStr, myIDX, 1) = Mid(MetaTagChars, tagIDX, 1) Then
　　　　　str_X = str_X & "\" & Mid(MetaTagChars, tagIDX, 1)
　　　　End If
　　　Next tagIDX

　　　If tagFlg = False Then
　　　　str_X = str_X & Mid(keywordStr, myIDX, 1)
　　　End If
　　Next myIDX

　　keywords_escape_sequence = str_X
　Else 'メタ文字を自分で記述するモード
　　keywords_escape_sequence = keywordStr
　End If

End Function

ありがとうございました。m(_ _)m

補足

アドバイスありがとうございます。

どうやら、[ → [[] 、[ → []] に置換する部分で、置換前データで上書きしていいたようです。自己解決で、すみません。

でも、せっかく教えて頂いたので、RegExp（正規表現というのですか？）でもできるように、今作っていますυ

Like演算子でも正規表現は使えると思うのですが、モドキなんでしょうか？

やはりRegExpというのでプログラムを組んだほうが、何かと応用が利くのでしょうか？

回答No.2

n-jun

n-junです。

＞Like演算子でも正規表現は使えると思うのですが、モドキなんでしょうか？
＞やはりRegExpというのでプログラムを組んだほうが、何かと応用が利くのでしょうか？
私的にはLike演算子と正規表現は違う物と認識してます。（実際はわかりませんよ）

ただ正規表現自体は、覚えておくと入力チェックなどにも応用できますし、
結構重宝していますのでお薦めしたいですね。

お礼

言葉足らずの中、回答頂きありがとうございました。
RegExpの方を使って、プログラミングを続けようと思います。

今日の夜、締め切ります。

補足

出来たので、一応載せておきます。

keywords_OK_Str = keywords_escape_sequence(frmKeywords.OK_BOX.Text)
keywords_NG_Str = keywords_escape_sequence(frmKeywords.NG_BOX.Text)

If keywords_OK(keywords_OK_Str, フルパス)) = True And _
　　keywords_NG(keywords_NG_Str, フルパス)) = True Then
　　　　　　　　'ファイルリスト作成
End if

※Microsoft VBScript Regular Expressions 5.5 にチェックを入れなくてもできました。

Public Function keywords_escape_sequence(keywordStr As String) As String

　　　　If keywordStr = "" Then
　　　　　　　　keywords_escape_sequence = ""
　　　　　　　　Exit Function
　　　　End If

　　　　Dim myIDX As Currency

　　　　Dim str_X As String

　　　　str_X = ""

　　　　For myIDX = 1 To Len(keywordStr) Step 1
　　　　　　　　If Mid(keywordStr, myIDX, 1) = "[" Then
　　　　　　　　　　　　str_X = str_X & "\["
　　　　　　　　ElseIf Mid(keywordStr, myIDX, 1) = "]" Then
　　　　　　　　　　　　str_X = str_X & "\]"
　　　　　　　　Else
　　　　　　　　　　　　str_X = str_X & Mid(keywordStr, myIDX, 1)
　　　　　　　　End If
　　　　Next

　　　　'メタ文字の一覧　　 http://codezine.jp/article/detail/1655

　　　　keywords_escape_sequence = str_X
End Function

Public Function keywords_NG(in_Str As String, target_Str As String) As Boolean
　　　　If in_Str = "" Then
　　　　　　　　keywords_NG = True
　　　　　　　　Exit Function
　　　　End If

　　　　Dim wordArray() As String

　　　　Erase wordArray()

　　　　wordArray() = Split(in_Str, Space(1)) '（スペースで区切ったキーワードを一個一個取り出し）

　　　　Dim tempFLG As Boolean

　　　　tempFLG = True

　　　　Dim wordIDX As Long

　　　　For wordIDX = 0 To UBound(wordArray) Step 1
　　　　　　　　If wordArray(wordIDX) <> "" Then
　　　　　　　　　　　　Dim RegExp As Object

　　　　　　　　　　　　Set RegExp = CreateObject("VBScript.RegExp")

　　　　　　　　　　　　RegExp.Pattern = wordArray(wordIDX)

　　　　　　　　　　　　If RegExp.Test(target_Str) Then
　　　　　　　　　　　　　　　　tempFLG = False '一個でも一致した場合、NG
　　　　　　　　　　　　End If

　　　　　　　　　　　　Set RegExp = Nothing
　　　　　　　　End If
　　　　Next

　　　　If tempFLG = True Then
　　　　　　　　keywords_NG = True
　　　　Else
　　　　　　　　keywords_NG = False
　　　　End If

End Function

Public Function keywords_OK(in_Str As String, target_Str As String) As Boolean
　　　　If in_Str = "" Then
　　　　　　　　keywords_OK = True
　　　　　　　　Exit Function
　　　　End If

　　　　Dim wordArray() As String

　　　　Erase wordArray()

　　　　wordArray() = Split(in_Str, Space(1))　　'（スペースで区切ったキーワードを一個一個取り出し）

　　　　Dim tempFLG As Boolean

　　　　tempFLG = False

　　　　Dim wordIDX As Long

　　　　For wordIDX = 0 To UBound(wordArray) Step 1
　　　　　　　　If wordArray(wordIDX) <> "" Then
　　　　　　　　　　　　Dim RegExp As Object

　　　　　　　　　　　　Set RegExp = CreateObject("VBScript.RegExp")

　　　　　　　　　　　　RegExp.Pattern = wordArray(wordIDX)

　　　　　　　　　　　　If RegExp.Test(target_Str) Then 'キーワードに一致でＯＫ
　　　　　　　　　　　　　　　　tempFLG = True '一個でも一致した場合、OK
　　　　　　　　　　　　End If

　　　　　　　　　　　　Set RegExp = Nothing
　　　　　　　　End If
　　　　Next

　　　　If tempFLG = True Then
　　　　　　　　keywords_OK = True
　　　　Else
　　　　　　　　keywords_OK = False
　　　　End If

End Function