FileDateTime

質問

Dim MyFileName As String
Dim MyPath As String
Dim NewName As String
Dim objFS As FileSystemObject
Dim objFol, shellObj, folderObj, MyFolderName, myFile
Dim New撮影日時 As String

Sub test()

MyFileName = "C:\Users\写真"

Set objFS = CreateObject("Scripting.FileSystemObject")
Set shellObj = CreateObject("Shell.Application")

With objFS
With .GetFolder(MyFileName)
For Each MyFolder In .SubFolders

MyPath = MyFileName & "\" & MyFolder.Name & "\"

Set objFol = objFS.GetFolder(MyPath)
Set folderObj = shellObj.Namespace(MyPath)

MyFileName = Dir(MyPath & "*.*")
Do While MyFileName <> ""

’ここでエラー
New撮影日時 = FileDateTime(MyPath & folderObj.ParseName(MyFileName))

MyFileName = Dir()
Loop

Next
End With
End With

Set objFS = Nothing

End Sub

このコードは何が変ですか？

写真フォルダに入っているサブフォルダの写真ファイルの撮影日時を取得したいのですが
FileDateTime(MyPath & folderObj.ParseName(MyFileName))
で
実行時エラー_91「オブジェクト変数またはWithブロック変数が設定されていません」
になります。

原因がわかりません。
オフィス２０１０、アクセスです。

回答No.3

real beatin（@realbeatin） · ベストアンサー

こんにちは。

> FileDateTime(MyPath & folderObj.ParseName(MyFileName))
> で
> 実行時エラー_91「オブジェクト変数またはWithブロック変数が設定されていません」
> になります。
>
> 原因がわかりません。

原因は、
　MyFileName = "C:\Users\写真"
↓
　MyPath = MyFileName & "\" & MyFolder.Name & "\"
↓　？
　MyFileName = Dir(MyPath & "*.*")
の不正なMyFileNameの使い回しです。
本来固定であるべき親フォルダーへのパスが、
Dir()の戻り値であるファイル名に上書きされていますから、
MyPathは、"C:\Users\写真\*"ではなくて、
ファイル名から始まる意味のない文字列になります。
従って、
　Set folderObj = shellObj.Namespace(MyPath)
は、正しくFolderオブジェクトを参照することができず、
（この場合はエラーを返さないので）folderObjの中身はNothingです。
この状態で、
　New撮影日時 = FileDateTime(MyPath & folderObj.ParseName(MyFileName))
を実行しようとしても、folderObjがNothingですので、
つまり、オブジェクト変数が設定されていませんから、
実行時エラー_91「オブジェクト変数またはWithブロック変数が設定されていません」
になります。
（もっとも、エラーに関しては、ご使用の環境（ＯＳやアプリケーションのバージョン）
　が解らないと、その分確度の低い返答しか出来ませんが、、、。）

エラー以外でも設計面に幾つか難があるように思います。
例えば、Scripting.Folderには、.Pathや.Nameといったプロパティがありますから、
　MyPath = MyFileName & "\" & MyFolder.Name & "\"
としなくても、
　MyPath = MyFolder.Path & "\"
で済みます。無理して文字列の連結を使うことは避けた方が間違いが減らせます。
また、FileDateTime()を使う為だけならば、ですが、
この関数の引数として渡す為のファイルパスを取得するのには、
ご提示のように
　Scripting.FileSystemObject オブジェクト
　Shell32.Folder オブジェクト
　Dir() 関数
３種類使う必要はなくて、どれか一つで済むことです。

> 写真フォルダに入っているサブフォルダの写真ファイルの撮影日時を取得したいのですが
最終更新日時（FileDateTime）ではなくて、
撮影日時ですよね？
せっかくShell.Application.NamespaceでFolderItemを取得しているのですから、
FolderItem.ExtendedProperty("WhenTaken")で取得した日付時刻を
簡易に+9:00して日本時間に直すやり方が割りと簡単ですけれど如何でしょう。
（添付画像の「撮影日時」は、この"WhenTaken"データを元に構成されています）

　FileSystemObject では サブフォルダのパスを取得するのみ
　FolderItem では
　　ファイル名から拡張子をチェックした上で（※）
　　撮影日時を取得します。
（※）フォルダには目に見えるファイルだけがあるという訳ではないので、
　　拡張子などで写真ファイル以外のものを除外する必要があります。
　　例として、拡張子.JPGの場合を挙げておきます。
　　後は実際の必要に合わせて条件を追加するなど応用してみて下さい。
手元の写真フォルダに対して、下記マクロを動かして確認したところでは、
ファイルの属性としての「撮影日時」は正しく取得出来ているようです。
厳密な意味での撮影日時となるとExif情報を読み込む方法とかになるのでしょうけれど、
それはまぁそれで簡単ではないのでここでは触れませんが、
ご自身で挑戦するのでしたら「vba exif情報取得」等で検索してみて下さい。
因みに、下記のマクロについても、
　Shell32.Folder オブジェクト
だけで機能させることは可能なのですが、
　Scripting.FileSystemObject オブジェクト
を併用する訳は、
ファイルサーチについては、より広く知られているオブジェクトだから
解り易いであろう、という点に尽きます。

◆確認用とマークした行は、取得結果を
イミディエイトウィンドウで確認する為だけの仮の記述です。
不要になったら、４行、削除してください。
（添付画像は「撮影日時」と「更新日時」それぞれの対応関係を示しています。）

' ' ///

' ' Refer ■ Scripting　　Microsoft Scripting Runtime
Sub test1()
Dim objFS As Scripting.FileSystemObject
Dim MyFolder As Scripting.Folder
Dim shellObj As Object　'　As Shell32.Shell
Dim folderObj　'　As Object　'　As Shell32.Folder3
Dim shFolderItem　'　As Object　'　As Shell32.FolderItem
Dim New撮影日時　'　As Date
Dim MyFolderName As String
Dim MyFileName As String

　　MyFolderName = "C:\Users\写真"

　　Set objFS = CreateObject("Scripting.FileSystemObject")
　　Set shellObj = CreateObject("Shell.Application")

Debug.Print "ファイル名", "撮影日時（WhenTaken）", "最終更新日時（FileDateTime）"　'　◆確認用
　　With objFS.GetFolder(MyFolderName)
　　　　For Each MyFolder In .SubFolders

　　　　　　Set folderObj = shellObj.Namespace(MyFolder.Path)　' & "\"
　　　　　　For Each shFolderItem In folderObj.Items
　　　　　　　　MyFileName = shFolderItem.Name
　　　　　　　　If UCase(MyFileName) Like "*.JPG" Then
　　　　　　　　　　New撮影日時 = shFolderItem.ExtendedProperty("WhenTaken")
　　　　　　　　　　New撮影日時 = DateAdd("h", 9, New撮影日時)
Debug.Print MyFileName, ;　'　◆確認用
Debug.Print New撮影日時, ;　'　◆確認用
Debug.Print FileDateTime(shFolderItem.Path)　'　◆確認用
　　　　　　　　End If
　　　　　　Next
　　　　　　Set folderObj = Nothing

　　　　Next
　　End With

　　Set shellObj = Nothing:　　Set objFS = Nothing

End Sub

' ' ///

お礼

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

回答No.2

nan93850673

"Scripting.FileSystemObject"だけで出来るのに、"Shell.Application"を使う意味が解らん。

Sub test()
Dim MyFileName As String
Dim New撮影日時 As String
Dim objFS As FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File

MyFileName = "C:\Users\写真"
Set objFS = New Scripting.FileSystemObject

For Each objFolder In objFS.GetFolder(MyFileName).SubFolders
For Each objFile In objFolder.Files
New撮影日時 = FileDateTime(objFile.Path)
Next objFile
Next

Set objFS = Nothing
End Sub

お礼

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

回答No.1

t-aka

＞Set folderObj = shellObj.Namespace(MyPath)
folderObjがNothingのままです。

また、動かしてみると、MyFolderNameとMyFileNameが混同しているように見えます。

以下、少しいじってみました。プロシージャのみ記載します。
-----
Sub test()

MyFolderName = "C:\Users\写真"

Set objFS = CreateObject("Scripting.FileSystemObject")
Set shellObj = CreateObject("Shell.Application")

With objFS
With .GetFolder(MyFolderName)
For Each MyFolder In .SubFolders

MyPath = MyFolderName & "\" & MyFolder.Name & "\"

Set objFol = objFS.GetFolder(MyPath)
Set folderObj = shellObj.Namespace(MyPath)

MyFileName = Dir(MyPath & "*.*")
Do While MyFileName <> ""

'ここでエラー
New撮影日時 = FileDateTime(MyPath & MyFileName)

MyFileName = Dir()
Loop

Next
End With
End With

Set objFS = Nothing

End Sub
-----

お礼

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