VBAでのORの使い方

質問

以下のようなVBAがあります。指定したフォルダーに保存されているエクセルのファイル名を取得するものです。
ここでやりたいのは、AとJPから始まるファイルを取得したいのですがうまくいきません。これですのコンパイルエラーが出ます。
どう変更すべきかご教示願います。

Sub ファイル名取得()
Const SEARCH_DIR As String = "\\SOGKF01.JP.TakataCorp.com\XXXXXXXX\YYYYY"
Const SEARCH_FILE As String = "AS*.xlsm" Or Const SEARCH_FILE As String = "JP*.xlsm"
Dim tmpFile As String
Dim strCmd As String
Dim buf() As Byte
Dim FileList() As String
Dim myArray() As String
Dim cnt As Long, pt As Long, i As Long

続く

回答No.4

kkkkkm · ベストアンサー

No3の他には以下のような感じでもいけると思います。

Sub ファイル名取得Test()
Const SEARCH_DIR As String = "\\zzzz\xxxx\yyyy"
Dim Serch_File() As Variant
Dim tmpFile As String
Dim strCmd As String
Dim buf() As Byte
Dim FileList() As String
Dim myArray() As String
Dim cnt As Long, pt As Long, i As Long

Serch_File = Array("AS*.xlsm", "JP*.xlsm")

'Dirコマンドの結果を出力する一時ファイル
tmpFile = Environ("TEMP") & "\Dir.tmp"

For i = 0 To UBound(Serch_File)
'Dirコマンド用の文字列を編集
strCmd = "Dir """ & SEARCH_DIR & "\" & Serch_File(i) & _
""" /b/s/a:-d >> """ & tmpFile & """"

'WSHでDirコマンドを実行 ---------------(1)
With CreateObject("Wscript.Shell")
.Run "cmd /c" & strCmd, 7, True
End With
Next

'該当ファイルの存在チェック
If FileLen(tmpFile) < 1 Then
MsgBox "該当するファイルがありません"
Exit Sub
End If

'Dirコマンドの結果を出力した一時ファイルを読み込み
Open tmpFile For Binary As #1
ReDim buf(1 To LOF(1))
Get #1, , buf
Close #1
Kill tmpFile

FileList() = Split(StrConv(buf, vbUnicode), vbCrLf)

'Dirコマンドの出力件数
cnt = UBound(FileList)

'ワークシート書き出し用の配列 ---------(2)
ReDim myArray(1 To cnt, 1 To 2)
For i = 1 To cnt
pt = InStrRev(FileList(i - 1), "\")
myArray(i, 1) = Left(FileList(i - 1), pt) 'パス
myArray(i, 2) = Mid(FileList(i - 1), pt + 1) 'ファイル名
Next i

'配列の値をワークシートに出力
'A,B列クリアー
Range("A2:B10000").Select

Selection.ClearContents
Range("A1").Value = "パス"
Range("B1").Value = "ファイル名"
Range("A2").Resize(cnt, 2).Value = myArray
End Sub

お礼

皆様どうもありがとうございました。大感謝です！
1名にしかベストアンサーを選べないのが残念です。

今後もどうぞよろしくお願いします。

回答No.6

kkkkkm

もうひとつおまけです。
CmdでDirをループするという手もあるようなので以下のようにしてもいける感じです。

Const SEARCH_FILE1 As String = "AS"
Const SEARCH_FILE2 As String = "JP"

strCmd = "for %x in (" & SEARCH_FILE1 & "," & SEARCH_FILE2 & ") do Dir /b/s/a:-d " & SEARCH_DIR & "\" & "%x*.xlsm >>" & tmpFile

回答No.5

kkkkkm

おまけです。

strCmd = "Dir """ & SEARCH_DIR & "\" & "*.xlsm" & _
""" /b/s/a:-d > """ & tmpFile & """"

にして

myArray(i, 2) = Mid(FileList(i - 1), pt + 1) 'ファイル名
If myArray(i, 2) Like SEARCH_FILE1 Or myArray(i, 2) Like SEARCH_FILE2 Then
セル書き込み用の配列= myArray(i, 2)
End If

というのもありだと思いますが、SEARCH_FILEの増減があったときに直すのが面倒そうです。

回答No.3

kkkkkm

今のコードを生かして簡単だと思える変更方法です。
Testを実行してください。

Sub Test()
Const SEARCH_DIR As String = "\\zzzz\xxxx\yyyy"
Const SEARCH_FILE1 As String = "AS*.xlsm"
Const SEARCH_FILE2 As String = "JP*.xlsm"

'A,B列クリアー
Range("A2:B10000").ClearContents
Range("A1").Value = "パス"
Range("B1").Value = "ファイル名"
Call ファイル名取得(SEARCH_DIR, SEARCH_FILE1)
Call ファイル名取得(SEARCH_DIR, SEARCH_FILE2)
End Sub

Sub ファイル名取得(ByVal SEARCH_DIR As String, ByVal SEARCH_FILE As String)
Dim tmpFile As String
Dim strCmd As String
Dim buf() As Byte
Dim FileList() As String
Dim myArray() As String
Dim cnt As Long, pt As Long, i As Long

Dim LastRow As Long '追加

以下 '配列の値をワークシートに出力まで変更なしで

変更なしの部分は略

'配列の値をワークシートに出力

'ここから変更
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(LastRow + 1, "A").Resize(cnt, 2).Value = myArray

End Sub

他の方法の場合はこちらのサイトを参考にしてください。
ファイルを検索する
http://officetanaka.net/excel/vba/tips/tips36.htm
フルパスをパスとファイル名に分ける
http://officetanaka.net/excel/vba/tips/tips78.htm

回答No.2

kkkkkm

Const SEARCH_FILE1 As String = "AS*.xlsm"
Const SEARCH_FILE2 As String = "JP*.xlsm"
にして(以下のFileNameは適当です)
If FileName Like SEARCH_FILE1 Or FileName Like SEARCH_FILE2 Then
一致したときの処理
End If
で試してみてください。

補足

早速どうもありがとうございます。しかし無知の私には事はそんなに簡単ではありませんでした。
以下が全てのコードす。どこにどう挿入したらいいのでしょうか？
Sub ファイル名取得()
Const SEARCH_DIR As String = "\\zzzz\xxxx\yyyy"
Const SEARCH_FILE1 As String = "AS*.xlsm"
Const SEARCH_FILE2 As String = "JP*.xlsm"
Dim tmpFile As String
Dim strCmd As String
Dim buf() As Byte
Dim FileList() As String
Dim myArray() As String
Dim cnt As Long, pt As Long, i As Long

'Dirコマンドの結果を出力する一時ファイル
tmpFile = Environ("TEMP") & "\Dir.tmp"

'Dirコマンド用の文字列を編集
strCmd = "Dir """ & SEARCH_DIR & "\" & SEARCH_FILE & _
""" /b/s/a:-d > """ & tmpFile & """"

'WSHでDirコマンドを実行 ---------------(1)
With CreateObject("Wscript.Shell")
.Run "cmd /c" & strCmd, 7, True
End With

'該当ファイルの存在チェック
If FileLen(tmpFile) < 1 Then
MsgBox "該当するファイルがありません"
Exit Sub
End If

'Dirコマンドの結果を出力した一時ファイルを読み込み
Open tmpFile For Binary As #1
ReDim buf(1 To LOF(1))
Get #1, , buf
Close #1
Kill tmpFile

FileList() = Split(StrConv(buf, vbUnicode), vbCrLf)

'Dirコマンドの出力件数
cnt = UBound(FileList)

'ワークシート書き出し用の配列 ---------(2)
ReDim myArray(1 To cnt, 1 To 2)
For i = 1 To cnt
pt = InStrRev(FileList(i - 1), "\")
myArray(i, 1) = Left(FileList(i - 1), pt) 'パス
myArray(i, 2) = Mid(FileList(i - 1), pt + 1) 'ファイル名
Next i

'配列の値をワークシートに出力
'A,B列クリアー
Range("A2:B10000").Select

Selection.ClearContents
Range("A1").Value = "パス"
Range("B1").Value = "ファイル名"
Range("A2").Resize(cnt, 2).Value = myArray
End Sub

回答No.1

m5048172715

Sub ファイル名取得()
Const SEARCH_DIR As String = "\\SOGKF01.JP.TakataCorp.com\XXXXXXXX\YYYYY"
Const SEARCH_FILE1 As String = "A*.xlsm"
Const SEARCH_FILE2 As String = "JP*.xlsm"
End Sub

これならOKっぽい。