Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


58813 / 76732 ←次へ | 前へ→

【22642】Re:Dir関数でサブフォルダまでファイル検索
発言  でれすけ  - 05/2/25(金) 10:31 -

引用なし
パスワード
   こんにちは。

もうほとんど解決のようなんですが、
Dir関数で書いてみましたので、何かの参考になれば。


Option Explicit

Sub sample()

Dim i As Long, n As Long
Dim FoundFiles As Variant
Dim WB As Workbook, WS As Worksheet

n = RecDir("d:\", "*表.xls", FoundFiles)

For i = 1 To n
  Set WB = Workbooks.Open(FoundFiles(i), ReadOnly:=True)
  If SheetExist(WB, "ver5.0", WS) Then
   MsgBox WB.Name & "に" & WS.Name & "がみつかりました"
  ElseIf SheetExist(WB, "Ver5.0", WS) Then
   MsgBox WB.Name & "に" & WS.Name & "がみつかりました"
  End If
  With WS
    'ワークシートに対する処理
  End With
  WB.Close SaveChanges:=False
Next

End Sub


Function SheetExist(WB As Workbook, ShName As Variant, Sh As Worksheet) As Boolean
On Error GoTo Not_Exist
 Set Sh = WB.Worksheets(ShName)
 SheetExist = True
 Exit Function
Not_Exist:
 SheetExist = False: Set Sh = Nothing
End Function

Function RecDir(ByVal Path As String, ByVal FileFilter As String, ByRef FoundFiles As Variant) As Long
Dim FileNames() As String, Folders() As String
Dim nFile As Long, nFolder As Long
Dim ret As Variant, i As Long, j As Long, n As Long

nFile = 0: nFolder = 0
Path = IIf(Right(Path, 1) = "\", Path, Path & "\")

ret = Dir(Path & FileFilter, vbNormal)
Do While ret <> ""
 If Path <> "." And Path <> ".." Then
   If (GetAttr(Path & ret) And vbNormal) = vbNormal Then
    nFile = nFile + 1
    ReDim Preserve FileNames(1 To nFile)
    FileNames(nFile) = Path & ret
   End If
 End If
 ret = Dir
Loop

ret = Dir(Path, vbDirectory)
Do While ret <> ""
 If ret <> "." And ret <> ".." Then
   If (GetAttr(Path & ret) And vbDirectory) = vbDirectory Then
    nFolder = nFolder + 1
    ReDim Preserve Folders(1 To nFolder)
    Folders(nFolder) = Path & ret
   End If
 End If
 ret = Dir
Loop

For i = 1 To nFolder
 n = RecDir(Folders(i), FileFilter, ret)
 If n > 0 Then
   ReDim Preserve FileNames(1 To nFile + n)
   For j = 1 To n
    FileNames(nFile + j) = ret(j)
   Next
   nFile = nFile + n
 End If
Next

RecDir = nFile: FoundFiles = FileNames
Erase FileNames, Folders
End Function
0 hits

【22592】Dir関数でサブフォルダまでファイル検索 05/2/24(木) 14:39 質問
【22594】Re:Dir関数でサブフォルダまでファイル検索 MMX 05/2/24(木) 15:06 発言
【22596】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/24(木) 15:47 発言
【22602】Re:Dir関数でサブフォルダまでファイル検索 05/2/24(木) 18:34 質問
【22610】Re:Dir関数でサブフォルダまでファイル検索 05/2/24(木) 19:35 質問
【22613】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/24(木) 19:46 発言
【22615】Re:Dir関数でサブフォルダまでファイル検索 05/2/24(木) 19:57 質問
【22617】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/24(木) 20:24 発言
【22620】Re:Dir関数でサブフォルダまでファイル検索 05/2/24(木) 21:48 質問
【22622】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/24(木) 22:06 発言
【22628】Re:Dir関数でサブフォルダまでファイル検索 05/2/24(木) 22:48 質問
【22630】Re:Dir関数でサブフォルダまでファイル検索 ichinose 05/2/24(木) 22:57 発言
【22632】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/24(木) 23:19 発言
【22641】Re:Dir関数でサブフォルダまでファイル検索 MMX 05/2/25(金) 10:17 お礼
【22642】Re:Dir関数でサブフォルダまでファイル検索 でれすけ 05/2/25(金) 10:31 発言
【22646】Re:Dir関数でサブフォルダまでファイル検索 05/2/25(金) 12:02 お礼
【22681】Re:Dir関数でサブフォルダまでファイル検索 05/2/28(月) 1:12 質問
【22682】Re:Dir関数でサブフォルダまでファイル検索 ちゃっぴ 05/2/28(月) 1:21 発言
【22683】Re:Dir関数でサブフォルダまでファイル検索 でれすけ 05/2/28(月) 1:28 回答
【22689】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/28(月) 13:27 発言
【22691】Re:Dir関数でサブフォルダまでファイル検索 05/2/28(月) 15:11 質問
【22693】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/28(月) 18:09 発言
【22694】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/28(月) 18:13 発言
【22700】Re:Dir関数でサブフォルダまでファイル検索 05/2/28(月) 20:13 質問
【22704】Re:Dir関数でサブフォルダまでファイル検索 kazu 05/2/28(月) 21:43 発言
【22705】Re:Dir関数でサブフォルダまでファイル検索 イオン 05/2/28(月) 21:48 お礼
【22722】Re:Dir関数でサブフォルダまでファイル検索 05/3/1(火) 10:18 お礼

58813 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free