みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

サブフォルダ内のファイル名取得について

Windows7 Access 2013環境です。
USB接続したハードディスク内のファイルリストを作成しようとしています。
ハードディスクはNTFSフォーマットです。

ボタン1をクリックしたとき、テーブル1をソースにしたフォーム1に
ファイル名を書き出していくようにしました。

ドライブ内のサブフォルダを選択すると、プログラムは正常に作動するのですが
ドライブ直下を指定すると、実行時エラー 70 "書き込みできません"
が発生します。

NTFSのアクセス権は、管理者でログインしているので、システム関連のフォルダ
System Volume Information
$RECYCLE.BIN
以外は問題ありません。

どこに問題があるのでしょうか。もし、システム関連のフォルダが
引っかかっているとしたら、その回避方法についても
具体的にご教授願います。


↓エラー箇所↓
--------------------------------------------------------------
For Each subfolder In folder.SubFolders
--------------------------------------------------------------


↓作成したプログラム↓
--------------------------------------------------------------
Private Sub ボタン_1_Click()

Dim dlg As FileDialog
Dim fold_path As String
Dim strTargetDir As String

DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec

Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

If dlg.Show = False Then Exit Sub

fold_path = dlg.SelectedItems(1)

strTargetDir = fold_path
Call FolderSearch(strTargetDir)
MsgBox "終了"

Set dlg = Nothing

Else

End If

End Sub

Public Sub FolderSearch(strTargetDir As String)

Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim file As Object

Dim objFilsSys As Object
Dim objDrive As Object
Dim strDriveLetter As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(strTargetDir)

strDriveLetter = Left(strTargetDir, 1)

Set objFileSys = CreateObject("Scripting.FileSystemObject")

Set objDrive = objFileSys.GetDrive(strDriveLetter)

For Each subfolder In folder.SubFolders  ←エラー箇所

FolderSearch subfolder.Path
Next subfolder

For Each file In folder.Files
With file
Me.ボリューム名 = objDrive.VolumeName
Me.ファイル名 = file.Name
Me.ファイルパス = folder.Path
Me.ファイルサイズ = folder.Size
DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec
End With
Next file

Set objDrive = Nothing
Set fso = Nothing
Set folder = Nothing

End Sub

投稿日時 - 2015-04-04 16:59:27

QNo.8949091

困ってます

質問者が選んだベストアンサー

すみません。かなり寝ぼけてました。。。
これでどうかな?(システムのあるCドライブでは失敗します)

Public Sub FolderSearch(strTargetDir As String)

Dim fso As Object
Dim folder As Object
Dim subFolder As Object
Dim file As Object

Dim objFileSys As Object
Dim objDrive As Object
Dim strDriveLetter As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(strTargetDir)

strDriveLetter = Left(strTargetDir, 1)

Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objDrive = objFileSys.GetDrive(strDriveLetter)

For Each file In folder.Files
'With file
Me.ボリューム名 = objDrive.VolumeName
Me.ファイル名 = file.Name
Me.ファイルパス = folder.Path
Me.ファイルサイズ = folder.Size
DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec
'End With
Next file


For Each subFolder In folder.SubFolders '←エラー箇所
If subFolder.Attributes <> 22 Then
FolderSearch subFolder.Path
End If
Next subFolder

Set objDrive = Nothing
Set fso = Nothing
Set folder = Nothing
End Sub

投稿日時 - 2015-04-07 14:38:19

補足

出来ました。記述する順序が、入れ替わったのは
わかるのですが、ループ処理をよくわかっていないので
今後勉強していこうと思います。
ついでに、いままでAccessを終了するまで、USBハードディスクを
つかんだままになっていて、パソコンから外せなくなっていたのですが、
修正したところ、Accessを終了しなくても、取り外せるようになりました。

投稿日時 - 2015-04-08 00:45:19

お礼

出来ました。ありがとうございます。記述する順序が、入れ替わったのは
わかるのですが、ループ処理をよくわかっていないので
今後勉強していこうと思います。

投稿日時 - 2015-04-08 00:45:12

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

よく読んではいませんが、
フォルダの属性で判断してスキップするとかでは?
前略
For Each subfolder In folder.SubFolders  ←エラー箇所
if subfolder.attributes=22 then
FolderSearch subfolder.Path
end if
Next subfolder
後略

22 は
Directory 16

System 4
の論理和です。

投稿日時 - 2015-04-04 22:46:29

補足

教えていただいた方法ですが、残念ながら回避できませんでした。

投稿日時 - 2015-04-07 01:10:48

あなたにオススメの質問