Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
Subプロシージャの呼び出し
投稿日時: 19/02/27 19:25:59
投稿者: wind

下記のところで、「オブジェクト変数またはWithブロック変数が設定されていません」というエラーが出てしまいます。どうすればよいか、ご教授いただけますようよろしくお願いいたします。
 
Sub GetFileName()
 Dim oFSO As Object, strFolder As String, i As Long
 Dim myPath As String
  
 
 myPath = Sheets("Path").Range("A1")
 
strFolder = myPath
 
  
i = 1
Sheets("Files").Columns("A:C").ClearContents
Set oFSO = CreateObject("Scripting.FileSystemObject")
 
 Call InputFileName(oFSO, strFolder, i)
 Set oFSO = Nothing
 
 End Sub
 
 
 Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As String, ByRef i As Long)
 Dim oFile As Object, oFolder
 Dim myName As String
   
Set shellObj = CreateObject("Shell.Application")
Set folderObj = shellObj.Namespace(strFolder)
 
 
For Each oFile In oFSO.GetFolder(strFolder).Files
 myName = oFile.Name
  
 Sheets("Files").Cells(i, 1) = Left(oFile.Path, Len(oFile.Path) - Len(oFile.Name))
 Sheets("Files").Cells(i, 2) = oFile.Name
 
============================ここでエラーが発生========================================
 Sheets("Files").Cells(i, 3) = folderObj.GetDetailsOf(folderObj.ParseName(myName), 12)
======================================================================================
  
 i = i + 1
 Next
 
For Each oFolder In oFSO.GetFolder(strFolder).SubFolders
  
 Call InputFileName(oFSO, oFolder.Path, i)
 Next
 
 End Sub
 
 
ちなみに、下記のSubプロシージャを呼び出ししないやり方で書いたところ、エラーは起きませんでした。
 
Sub test()
 Dim oFile As Object, oFolder As Object
 Dim shellObj, folderObj
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
i = 1
 
For Each oFile In oFSO.GetFolder("D:\Selected\F1").Files
  
Set shellObj = CreateObject("Shell.Application")
Set folderObj = shellObj.Namespace("D:\Selected\F1")
  
 myName = oFile.Name
 
 ActiveWorkbook.Sheets("Files").Cells(i, 1) = Left(oFile.Path, Len(oFile.Path) - Len(oFile.Name))
 Sheets("Files").Cells(i, 2) = oFile.Name
 Sheets("Files").Cells(i, 3) = folderObj.GetDetailsOf(folderObj.ParseName(myName), 12)
 i = i + 1
 Next
 
 
 
End Sub

回答
投稿日時: 19/02/27 19:41:10
投稿者: WinArrow
投稿者のウェブサイトに移動

エラーになる方のコードに
> Dim shellObj, folderObj
の記述が抜けているような気がします。

回答
投稿日時: 19/02/27 19:42:43
投稿者: WinArrow
投稿者のウェブサイトに移動

モジュールの先頭に
 
Option Explicit
 
を記述しましょう。

投稿日時: 19/02/27 19:49:22
投稿者: wind

WinArrow さんの引用:
エラーになる方のコードに
> Dim shellObj, folderObj
の記述が抜けているような気がします。

 
すみません、色々書き替えたりしているうちに抜けてしまってました。
ですが、この記述を加えても、まだエラーが起きてしまいます。
 
 Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As String, ByRef i As Long)
 Dim oFile As Object, oFolder
 Dim shellObj, folderObj
 Dim myName As String

投稿日時: 19/02/27 19:51:06
投稿者: wind

WinArrow さんの引用:
モジュールの先頭に
 
Option Explicit
 
を記述しましょう。

 
 
こちらも追加いたしましたが、まだエラーが起きてしまいます。。
 
Option Explicit
 
Sub GetFileName()
・・・・・

回答
投稿日時: 19/02/27 20:16:30
投稿者: Suzu

同じことを質問するならなぜ閉じたのでしょう。
 

引用:
そのうえで、myName に、何が入っていますか?
本来何が入ってほしいのでしょうね?

回答
投稿日時: 19/02/27 20:34:47
投稿者: WinArrow
投稿者のウェブサイトに移動

使ったことがないので、あてづっぽうで
 
> Sheets("Files").Cells(i, 3) = folderObj.GetDetailsOf(myName, 12)
 
でいかが?

投稿日時: 19/02/27 20:49:53
投稿者: wind

Suzu さんの引用:
同じことを質問するならなぜ閉じたのでしょう。
 
引用:
そのうえで、myName に、何が入っていますか?
本来何が入ってほしいのでしょうね?

 
 
myNameにはxxxx.jpgというファイル名が入っています。
それでは間違っているでしょうか。

投稿日時: 19/02/27 20:51:14
投稿者: wind

WinArrow さんの引用:
使ったことがないので、あてづっぽうで
 
> Sheets("Files").Cells(i, 3) = folderObj.GetDetailsOf(myName, 12)
 
でいかが?

 
 
 
 Sheets("Files").Cells(i, 3) = folderObj.GetDetailsOf(myName, 12)
に変えてみましたが、やはり同じエラーが出てしまいます。。

回答
投稿日時: 19/02/27 22:04:02
投稿者: WinArrow
投稿者のウェブサイトに移動

こちらで実行したサンプルコードを提示します。
 
これを参考にコードを修正してみてください。
 
Sub Sample2()
    Dim objShell, objFolder, i As Long, Target As String, myDT As String
    Target = "IMG_20190112_153549.jpg"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("C:\Users\xxxx\Pictures")
    myDT = objFolder.GetDetailsOf(objFolder.ParseName(Target), 12)
    Debug.Print Mid$(myDT, 2, 4) & "/" & Mid$(myDT, 8, 2) & "/" & Mid(myDT, 12, 2) & " " & Mid$(myDT, 17, 5)
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

投稿日時: 19/02/27 22:40:45
投稿者: wind

WinArrow さんの引用:
こちらで実行したサンプルコードを提示します。
 
これを参考にコードを修正してみてください。
 
Sub Sample2()
    Dim objShell, objFolder, i As Long, Target As String, myDT As String
    Target = "IMG_20190112_153549.jpg"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace("C:\Users\xxxx\Pictures")
    myDT = objFolder.GetDetailsOf(objFolder.ParseName(Target), 12)
    Debug.Print Mid$(myDT, 2, 4) & "/" & Mid$(myDT, 8, 2) & "/" & Mid(myDT, 12, 2) & " " & Mid$(myDT, 17, 5)
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

 
 
 
以下のように書き換えてみましたが、やはり同じエラーとなってしまいました。。
 
Option Explicit
 
 
Sub GetFileName()
 Dim oFSO As Object, strFolder As String, i As Long
 Dim myPath As String
  
 
 myPath = Sheets("Path").Range("A1")
 
strFolder = myPath
 
  
 '?t?H???_???t?@?C???????
i = 1 '1?s????????
Sheets("Files").Columns("A:C").ClearContents 'A-C??N???A
Set oFSO = CreateObject("Scripting.FileSystemObject")
 
 Call InputFileName(oFSO, strFolder, i)
 Set oFSO = Nothing
 
 End Sub
 
 
 Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As String, ByRef i As Long)
 Dim oFile As Object, oFolder
 Dim shellObj, folderObj
 Dim myName As String
 Dim myDT
   
 
Set shellObj = CreateObject("Shell.Application")
Set folderObj = shellObj.Namespace(strFolder)
 
 
For Each oFile In oFSO.GetFolder(strFolder).Files
  
  
 myName = oFile.Name
  
 Sheets("Files").Cells(i, 1) = Left(oFile.Path, Len(oFile.Path) - Len(oFile.Name))
 Sheets("Files").Cells(i, 2) = oFile.Name
  
 myDT = folderObj.GetDetailsOf(folderObj.ParseName(myName), 12)
 Sheets("Files").Cells(i, 3) = myDT
  
 i = i + 1 '????s+1
  
 Next
 
For Each oFolder In oFSO.GetFolder(strFolder).SubFolders
  
 Call InputFileName(oFSO, oFolder.Path, i)
 Next
 
 Set shellObj = Nothing
 Set folderObj = Nothing
  
 End Sub

投稿日時: 19/02/27 23:06:45
投稿者: wind

単独のプロシージャの場合はうまくいくので、プロシージャを呼び出すことに何か上手くいかない原因があるような気がしています。

回答
投稿日時: 19/02/28 08:07:17
投稿者: WinArrow
投稿者のウェブサイトに移動

>Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As String, ByRef i As Long)

Private Sub InputFileName(ByRef oFSO As Object, ByVal strFolder As String, ByRef i As Long)
 
修正してみてください。

投稿日時: 19/02/28 08:13:55
投稿者: wind

WinArrow さんの引用:
>Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As String, ByRef i As Long)

Private Sub InputFileName(ByRef oFSO As Object, ByVal strFolder As String, ByRef i As Long)
 
修正してみてください。

 
 
 Private Sub InputFileName(ByRef oFSO As Object, ByVal strFolder As String, ByRef i As Long)
に修正しましたが、
 myDT = folderObj.GetDetailsOf(folderObj.ParseName(myName), 12)
のところでやはりエラーが起きてしまいました。。。

回答
投稿日時: 19/02/28 10:21:24
投稿者: Suzu

解決策は判ったのですが理由は不明。
 
『Micirosoft Shell Controls And Automation』に対し参照設定を行って、
Dim shellObj As Shell32.Shell
 
こうしないと
 
Set folderObj = shellObj.Namespace(strFolder)
 
folderObj が、 Nothing となります。

回答
投稿日時: 19/03/01 16:30:38
投稿者: Abyss2

> 理由は不明
 
これは、IShellDispatchのNameSpaceメソッドが要求する引数型がVARIANT型だからです。
 

[id(0x60020002), helpstring("Get special folder from ShellSpecialFolderConstants")]
Folder* NameSpace([in] VARIANT vDir);

質問者さんのコードの場合、下記のように修正すればよいと思います。
 
Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As String, ByRef i As Long)
...
   ↓
Private Sub InputFileName(ByVal oFSO As Object, ByVal strFolder As Variant, ByRef i As Long)
...

回答
投稿日時: 19/03/03 09:35:33
投稿者: Suzu

Abyss2さん
 
引数の型違いですか・・気付けなかった・・
勉強になりました。

トピックに返信