VBAのDir関数でサブディレクトリを取得したいが、「ファイルが見つかりません」というエラーが出る

Dir関数でサブフォルダを取得する

上記サイトの一番最後のコードを実行してみましたが、「ファイルが見つかりません」というエラーが出てしまいます。
デバッグしてみるとIf GetAttr(buf) And vbDirectory Thenの行でエラーとなりますが、その理由が分からないので教えていただきたいです。

Sub Sample6()
    Dim buf As String, msg As String
    buf = Dir("C:\Users\nobu\Desktop\gccStudy\*.*", vbDirectory)
    Do While buf <> ""
        If GetAttr(buf) And vbDirectory Then
            If buf <> "." And buf <> ".." Then msg = msg & buf & vbCrLf
        End If
        buf = Dir()
    Loop
    MsgBox msg
End Sub

指定するフォルダの中身は以下のようになっています。

C:\Users\nobu\Desktop\gccStudy
└─aaa.exe      → ファイル
└─-cat.c      → ファイル
└─新しいフォルダー  → フォルダー

行動規範の内容に同意します

回答2件

ベストアンサー

GetAttr が絶対パスで受け取っていないからです。

vbs
1buf = Dir("C:\Users\nobu\Desktop\gccStudy\*.*", vbDirectory)

buf には見つかったフォルダ名もしくはファイル名のみが入ります。ですので . や .. はどのディレクトリにもあるのでスルーされますが、突然現れる良く分からないフォルダやファイルは GetAttr がエラーを返します。

以下の様に GetAttr も絶対パスで見る様にすれば直るかと思います

vbs
1Sub Sample6()
2    Dim buf As String, msg As String, basedir As String
3
4    basedir = "C:\Users\nobu\Desktop\gccStudy"
5    buf = Dir(basedir & "\*.*", vbDirectory)
6    Do While buf <> ""
7        If GetAttr(basedir & "\" & buf) And vbDirectory Then
8            If buf <> "." And buf <> ".." Then msg = msg & buf & vbCrLf
9        End If
10        buf = Dir()
11    Loop
12    MsgBox msg
13End Sub