
今、フォルダ内のファイルリストを作成する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ベストアンサー
- 回答日時:
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 'キーワードに一致でOK
MsgBox v(i)
End If
Next
MsgBox "チェンジ"
For i = 1 To 3
If Not RegExp.Test(v(i)) Then 'キーワードに不一致でOK
MsgBox v(i)
End If
Next
Set RegExp = Nothing
Erase v
End Sub
勘違いでしたらスル~して下さい。
この回答への補足
アドバイスありがとうございます。
どうやら、[ → [[] 、[ → []] に置換する部分で、置換前データで上書きしていいたようです。自己解決で、すみません。
でも、せっかく教えて頂いたので、RegExp(正規表現というのですか?)でもできるように、今作っていますυ
Like演算子でも正規表現は使えると思うのですが、モドキなんでしょうか?
やはりRegExpというのでプログラムを組んだほうが、何かと応用が利くのでしょうか?
メタ文字すべてをエスケープ(?)してみました。
キーワードをセットするボタンに、エラー処理を作りましたが、文字制限のあるので、載せていません。
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
No.2
- 回答日時:
n-junです。
>Like演算子でも正規表現は使えると思うのですが、モドキなんでしょうか?
>やはりRegExpというのでプログラムを組んだほうが、何かと応用が利くのでしょうか?
私的にはLike演算子と正規表現は違う物と認識してます。(実際はわかりませんよ)
ただ正規表現自体は、覚えておくと入力チェックなどにも応用できますし、
結構重宝していますのでお薦めしたいですね。
この回答への補足
出来たので、一応載せておきます。
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 'キーワードに一致でOK
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
言葉足らずの中、回答頂きありがとうございました。
RegExpの方を使って、プログラミングを続けようと思います。
今日の夜、締め切ります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) シート削除のマクロで「deleteメソッドは失敗しました」となります。助けてください! Sub 不要 6 2022/09/08 16:41
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) InputBoxでキャンセルボタンを押したらファイル自体を閉じたい 3 2022/07/23 17:52
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Excel(エクセル) エクセルVBAでオブジェクトが必要です 2 2022/09/10 16:37
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルvbaでdocuworksprinter...
-
エクセルVBAで一つ上の階層...
-
Excel 相対パス
-
コマンドプロンプトのコピー関...
-
xcopyコマンドの進行状況を表示...
-
Eclipse
-
VBAとロングファイル名
-
ACCESSからEXCEL起動時、パス名...
-
ルミーズショッピングカート
-
アクセス 自身のデータベース...
-
ExcelのVBAで上書き保存を確...
-
エクセルでパスを含んだファイル名
-
VBAでパスを取得した後、分割し...
-
VBAでパワーシェルを実行したい...
-
visual studio 2010のワーニング
-
VBAで、VBのapp.pathと同じ機能...
-
EXCEL(VBA)で指定フォルダ内の...
-
Excel VBA
-
Windowsファイルパスの妥当性に...
-
fopenでのパス指定
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルvbaでdocuworksprinter...
-
エクセルVBAで一つ上の階層...
-
xcopyコマンドの進行状況を表示...
-
Excel 相対パス
-
実行ファイルのパスを取得したい
-
コマンドプロンプトのコピー関...
-
【VB.NET】App.configにファイ...
-
エクセルのマクロで特定フォル...
-
VBA★PDFをPDFアプリで印刷し...
-
ExcelVBAの使い方 ¥の使い方...
-
fopenでのパス指定
-
ExcelのVBAで上書き保存を確...
-
EXCEL(VBA)で指定フォルダ内の...
-
C#でのProcess.Startと変数path
-
【VBA】ExcelマクロでCSVファイ...
-
VBAでパワーシェルを実行したい...
-
A列に記載されているフォルダ...
-
初心者powershellのPS1ファイル...
-
Eclipse
-
VBAとロングファイル名
おすすめ情報