フォルダーとファイルの認識

質問

フォルダーとファイルを認識するため、
例として下記のVBAを実行します。

If (GetAttr("D:\winpobox-0.1\win2000") And vbDirectory) = vbDirectory Then
MsgBox "フォルダ。"
Else
MsgBox "ファイル。"
End If
結果は、「フォルダ」となりますが、
「win2000」が「win.2000」とwinと2000の間に「.」（ドット）が入ると「ファイルが見つかりません。」となります。
フォルダー名にドットが入っても識別できる方法はありますか。

よろしくお願いいたします。

回答No.4

duke_kimura · ベストアンサー

付け焼刃になりますがソースコードの中に「2箇所」あるIfの条件を変更することで動作するのではないかと思います。

----------------------------------------------------
Else

'If hantei_l > 0 And hantei_r = "0" Then　　// この行を↓に変更

If ((GetAttr(strDirPatha) And vbDirectory) = vbDirectory) And _
(filename <> "." And filename <> "..") Then

foldername = FSO.getFOLDER(strDirPath).Name
.....
----------------------------------------------------

製作者の意図はすべて汲み取れませんでしたが、
恐らくここではvbNormal(通常ファイル)から漏れたその他のパス(ディレクトリ、隠しファイル、読み取り専用ファイル等)をふるいにかけ、「拡張子がないものをフォルダとして扱おうとした」のだと思います。
その際「win.2000」フォルダについていたドットが拡張子として見なされ、フォルダとして扱われていない様でした。

ソースコードを拝見する限り、教育を受けたプログラマが組んだ物ではないので、時間があればそのうち作り直した方が良いと思います。構造がかなり雑です。

お礼

ご回答ありがとうございます。
私も、独学の部類ですので、もう少し勉強して修正してみます。
ありがとうございました。

回答No.3

duke_kimura

>> フォルダーに「ドット」があるとエラーが出ていました。

前述の通り、例のソースコードは私の環境では問題なく動作しています。
エラーになる現象を再現できるパスは他にないでしょうか？

また、「"D:\winpobox-0.1\win2000"」の部分、実際はどこかのセルから値を拾ってきているでしょうか？
その場合は該当セルの書式指定も教えてください。

補足

ご連絡ありがとうございます。
コードは、下記の通りとなります。
最初のパスは、シートの”ｃ１”を参照します。

strdirpathaは判定に用いるためのものです。
フォルダー内にドットがなければ、すべてのフィイルの抽出ができますが、ドットがあると、ドットが有るフォルダー以外のファイルは抽出されエラーとなります。
検討材料になりますか。

Private Sub CommandButton2_Click()

ThisWorkbook.Sheets(1).Range("B2") = "ファイル名"
ThisWorkbook.Sheets(1).Range("C2") = "フォルダ名"
ThisWorkbook.Sheets(1).Range("D2") = "最終更新日"
ThisWorkbook.Sheets(1).Range("E2") = "説明"
ThisWorkbook.Sheets(1).Range("B2:E2").Interior.Color = RGB(0, 0, 0)
ThisWorkbook.Sheets(1).Range("B2:E2").Font.Color = RGB(255, 255, 255)
ThisWorkbook.Sheets(1).Range("B2:Es2").HorizontalAlignment = xlCenter

Dim strDirPath As String

Dim folview As String
Dim foldername As String
Dim filedate As Variant
Dim hantei_f As Variant
Dim hantei_r As Variant
Dim filename As String
Dim hantei_l As Integer
Dim n As Integer
Dim fol_cnt As Integer
Dim cnt As Integer
Dim fol_hai(10000) As String

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

foldername = ""
hantei_f = ""
hantei_r = ""
hantei_l = 0
n = 3
i = 0
r = 0

'*********************************************************
' 　指定したパス名末尾の\処理
'*********************************************************

strDirPath = Range("c1")

hantei_f = Right(strDirPath, 1)

If hantei_f = "\" Then
filename = Dir(strDirPath, 16)
Else
strDirPath = strDirPath & "\"
filename = Dir(strDirPath, 16)
End If

'*********************************************************
' 　　　 初回　ファイル名抽出
'*********************************************************

filename = Dir(strDirPath, 16)
hantei_l = Len(filename)
hantei_r = InStr(filename, ".")
fol_cnt = FSO.getFOLDER(strDirPath).subfolders.count
cnt = fol_cnt
strDirPatha = strDirPath & filename

Do While filename <> ""

If (GetAttr(strDirPatha) And vbDirectory) = vbNormal Then
foldername = FSO.getFOLDER(strDirPath).Name
fol_view = strDirPath
filedata = FileDateTime(strDirPath & filename)
Sheet1.Cells(n, 2) = filename
Sheet1.Cells(n, 3) = fol_view
Sheet1.Cells(n, 4) = filedata

n = n + 1
Else
If hantei_l > 0 And hantei_r = "0" Then
foldername = FSO.getFOLDER(strDirPath).Name
fol_hai(i) = strDirPath & filename & "\"
i = i + 1
End If

End If

filename = Dir()
hantei_l = Len(filename)
hantei_r = InStr(filename, ".")
strDirPatha = strDirPath & filename

Loop

If fol_cnt > 0 Then

'*********************************************************
'　　　　サブフォルダが存在する場合の処理（配列）
'　　　（サブフォルダが空の場合読み飛ばします。）
'*********************************************************

While r < cnt

strDirPath = fol_hai(r)

filename = Dir(strDirPath, 16)
hantei_l = Len(filename)
hantei_r = InStr(filename, ".")
fol_cnt = FSO.getFOLDER(strDirPath).subfolders.count

Do While filename <> ""

If (GetAttr(strDirPatha) And vbDirectory) = vbNormal Then
foldername = FSO.getFOLDER(strDirPath).Name
filedata = FileDateTime(strDirPath & filename)
fol_view = strDirPath
Sheet1.Cells(n, 2) = filename
Sheet1.Cells(n, 3) = fol_view
Sheet1.Cells(n, 4) = filedata

n = n + 1
Else
If hantei_l > 0 And hantei_r = "0" Then
foldername = FSO.getFOLDER(strDirPath).Name
fol_hai(i) = strDirPath & filename & "\"
i = i + 1
End If
End If

filename = Dir()
hantei_l = Len(filename)
hantei_r = InStr(filename, ".")
strDirPatha = strDirPath & filename

Loop

cnt = fol_cnt + cnt
r = r + 1

Wend

MsgBox "サブフォルダ有　フォルダ抽出完了"

Else

MsgBox "サブフォルダ無　フォルダ抽出完了"

End If

End Sub

回答No.2

wormhole

>フォルダー名にドットが入っても識別できる方法はありますか。

D:\winpobox-0.1\win.2000 は実際に存在するディレクトリ(またはファイル)なのでしょうか？

補足

このパスは、仮想です。

回答No.1

duke_kimura

>> フォルダー名にドットが入っても識別できる方法はありますか。

実際に試してみたところWin7+2003では正常に動作したように思います。

で、考えてみたのですが、もしかしてお聞きになりたいことは、
「フォルダ名に.が含まれている場合に、記載のコードが動かない(何が悪いのか？)」
ではなく、
「フォルダ名に.が含まれている場合でも、含まれていない時のように識別をしたい」
でしょうか？

前者の意味である場合は、とりあえず\をエスケープして「D:\\winpobox-0.1\\win2000」としてみてください。
後者の意味である場合は、多分正規表現で可能ですが、同一フォルダに「win.2000」フォルダと「win.2000」ファイルが存在した場合の制御などを考えなければなりません。

補足

ご回答ありがとうございます。
質問の主旨は、以前よりエクセルの別のコードで不特定フォルダーのファイルをパス名とファイル名を抽出していましたが、同様にフォルダーに「ドット」があるとエラーが出ていました。
そのマクロは同僚が作成したもので、今はその同僚はいません。マクロにエラーが出る原因は分かっていましたので、原因を取り除きながら（例、「ドット」を取り除く等）行っていました。
しかし、他者が作成したフォルダーを勝手に修正できないことがあります。
よって、マクロの修正を試みています。フォルダーとファイルの識別マクロを検索していると、質問のマクロに出会いました。
結果は、質問の内容でした。
GetAttr関数に「ドット」の扱いが含まれているのではないかとの疑問も含んでおります。
他者が作成したフォルダー、ファイルが含まれているため、名称の統一性はありません。
何か良いヒントのご教唆が頂ければと投稿した次第です。

乱文乱筆ですが、よろしくお願いいたします。