GetAttrが原因？

http://officetanaka.net/excel/vba/tips/tips95.htm
を参考に、
フォルダの一覧を取得するコードを作ってるのですが
Sample4ならエラーにならずにフォルダの一覧を取得できるのですが、
フォルダ名にドットがある場合も取得されてしまうので、Sample6を使いたいのですが、
If GetAttr(buf) And vbDirectory Then
の部分で、
「53ファイルが見つかりません。」
のエラーになります。

なぜでしょうか？

No.3 ベストアンサー 回答者： end-u 回答日時： 2012/12/19 21:01

参照ページのSample6を修正なくそのまま使ってる場合は

>「53ファイルが見つかりません。」
このエラーは出ないはずです。

例えば
Sub Sample6()
　　Dim buf As String, msg As String
　　buf = Dir("C:\TEST\*.*", 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
このようにDir関数で、カレントフォルダではなく、特定フォルダを指定するように修正してあると
ご提示のエラーになります。

変数bufにはDir関数の結果、ファイル名が入ります。
これに対して「GetAttr(buf)」この箇所を修正していないと、
ファイル名しか指定していない事になりますから、
カレントフォルダ&ファイル名になって、「53ファイルが見つかりません。」となります。

参照ページの冒頭に
>なお、カレントフォルダはC:\Workにしてあります。
とありますね。
フォルダ指定を省略してありますから、Dir関数もGetAttr関数もカレントフォルダ
つまり「C:\Work」に対する処理とみなされます。

修正するなら両方必要。
buf = Dir("C:\TEST\*.*", vbDirectory)
If GetAttr("C:\TEST\" & buf) And vbDirectory Then



ただ、対象フォルダにUnicode文字を使ったファイル名があると、
GetAttr関数のところで今度は「52　ファイル名または番号が不正です」のエラーになります。
直下のフォルダだけ取得するようなケースなら「FileSystemObject」を使ったほうが楽かもしれません。

Sub try()
　　Const p = "C:\TEST\"
　　Dim f As Object
　　Dim s As String

　　For Each f In CreateObject("scripting.filesystemobject").GetFolder(p).SubFolders
　　　　s = s & f.Name & vbLf
　　Next
　　MsgBox s
End Sub

この回答へのお礼

ありがとうございました。

お礼日時：2012/12/23 11:00

No.2 回答者： angel_Z 回答日時： 2012/12/19 09:52

参考URL　付け忘れました

http://d.hatena.ne.jp/bhunji2000/20091030/125813 …

この回答へのお礼

ブログ見てみます。

お礼日時：2012/12/19 21:25

No.1 回答者： angel_Z 回答日時： 2012/12/19 09:50

こんにちは。

フォルダ内に、読み取り専用フォルダがあるとエラーがおきますので、

Sub Sample6()
Dim buf As String, msg As String
Dim zokusei As Integer, enzan As Integer
Dim Path_Str as String

Path_Str = "C:\Documents and Settings\" '最後のフォルダが読み取り専用フォルダの場合は、\をつけないとエラーがおきます

buf = Dir(Path_Str, vbDirectory + vbHidden) '←読み取り専用追加
Do While buf <> ""
zokusei = Getattr(Path_str & buf)
enzan = zokusei And 16

If enzan = 16 Then
If buf <> "." And buf <> ".." Then msg = msg & buf & vbCrLf
End If
buf = Dir()
Loop
MsgBox msg
End Sub

この回答へのお礼

読み取り専用フォルダがあるとエラーになるのですか。
知りませんでした。
vbHiddenを追加したらうまく行きました。ありがとうございました。

お礼日時：2012/12/19 21:25