Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1089 / 13644 ツリー ←次へ | 前へ→

【76333】「サブフォルダ内ファイルのプロパティ取得」について おさむ 14/11/1(土) 1:52 質問[未読]
【76334】Re:「サブフォルダ内ファイルのプロパティ... マルチネス 14/11/1(土) 7:42 発言[未読]
【76335】Re:「サブフォルダ内ファイルのプロパティ... おさむ 14/11/1(土) 9:42 お礼[未読]
【76342】Re:「サブフォルダ内ファイルのプロパティ... カリーニン 14/11/1(土) 20:39 発言[未読]
【76345】Re:「サブフォルダ内ファイルのプロパティ... おさむ 14/11/1(土) 21:51 回答[未読]
【76349】Re:「サブフォルダ内ファイルのプロパティ... カリーニン 14/11/1(土) 23:24 発言[未読]
【76350】Re:「サブフォルダ内ファイルのプロパティ... おさむ 14/11/1(土) 23:30 お礼[未読]
【76378】Re:「サブフォルダ内ファイルのプロパティ... 渡辺真 14/11/10(月) 10:52 回答[未読]

【76333】「サブフォルダ内ファイルのプロパティ取...
質問  おさむ  - 14/11/1(土) 1:52 -

引用なし
パスワード
   はじめましてこんばんは。
仕事の必要上、「サブフォルダを含めた全フォルダの中の、全ファイルのプロパティ(詳細情報)の一覧作成」マクロを、vbaの知識がないことからweb上の作例を参考に作ろうとしているのですが、全くうまく動きません。

大変お恥ずかしいのですが、下の記述で修正個所等を教えてください。
よろしくお願いします。

Sub ファイルプロパティ一覧()
  Dim フォルダパス As String
  Dim ファイルタイプ As String
  Dim エラーカウント As Integer
  Dim 拡張子 As String
  Dim メッセージ As String
  Dim 開始日時 As Variant
  Dim 終了日時 As Variant
  Dim 既存データ As Integer
  Dim 追加シート名初期 As String
  Dim 追加シート名 As String
  Dim 重複 As Integer
  Dim シート As Worksheet
  Dim シート数 As Integer

  追加シート名初期 = "ファイプロパティ"
  追加シート名 = 追加シート名初期
  
  ThisWorkbook.Worksheets("スタートシート").Activate
  
  For 重複 = 1 To 100
     For Each シート In Worksheets
      If シート.Name = 追加シート名 Then
        追加シート名 = 追加シート名初期 & "(" & 重複 & ")"
      End If
    Next シート
  Next 重複
  シート数 = Worksheets.Count
  Worksheets("テンプレート02").Copy After:=Worksheets(シート数)
  ActiveSheet.Name = 追加シート名

  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path
  
   フォルダパス = Application.GetOpenFilename(ファイルタイプ)
 
    If フォルダパス = "False" Then End
 
  開始日時 = Now        ' 開始時刻を変数に格納

   フォルダパス = Left(フォルダパス, InStrRev(フォルダパス, "\"))

     On Error GoTo エラー表示

  項目数 = 40
  ReDim ファイルプロパティ(項目数, 1)
  
  Call ファイル検索(フォルダパス, ファイルプロパティ, 拡張子)
  
  Worksheets(追加シート名).Activate
  
  Range("A3").Resize(UBound(ファイルプロパティ, 2), 項目数) _
  = WorksheetFunction.Transpose(ファイルプロパティ)
  
  Range("A3").Select

  終了日時 = Now
  MsgBox "処理時間は、" _
  & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

  Exit Sub 'エラー以外は、以下のラベル部分を実行させないためのテクニック。

エラー表示:

  エラーカウント = エラーカウント + 1
  メッセージ = "エラーが発生しました。" & Chr(13) _
  & "フォルダパス= " & フォルダパス & Chr(13) _
  & "フルパス= " & フルパス & Chr(13) _
  & "UBound(ファイルプロパティ, 2)= " & UBound(ファイルプロパティ, 2) & Chr(13) _
  & "ActiveWorkbook名= " & ActiveWorkbook.Name & Chr(13) _
  & "エラー番号 " & Str(Err.Number) & Err.Source & _
  " でエラーが発生しました。" & Chr(13) & Err.Description
  
  MsgBox メッセージ, , "エラー", Err.HelpFile, Err.HelpContext
  
  ActiveWorkbook.Close False

  If エラーカウント > 5 Then Exit Sub
  Resume Next
End Sub


Sub ファイル検索(フォルダパス As String, ファイルプロパティ() As String, 拡張子 As String)
'再帰処理でファイル抽出

  Dim i As Integer
  Dim strFileName As Variant
  Dim 行 As Integer
  Dim 列 As Integer
  Dim ファイル As Integer
  Dim データ(10000, 65) As Variant
  Dim 追加シート名 As String
  Dim ファイル拡張子 As String
  Dim ファイル名 As String
  Dim objShell As Object
  Dim objFolder As Object
  
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.Namespace(フォルダパス)
 
  For i = 0 To 40
    データ(0, i) = objFolder.GetDetailsOf(objFolder.Items, i)
  Next
  ファイル = 0
  For Each strFileName In objFolder.Items
 
   ファイル名 = CStr(strFileName)
   ファイル拡張子 = LCase(Right(ファイル名, Len(ファイル名) - InStrRev(ファイル名, ".")))
   If 拡張子 = "*" Then ファイル拡張子 = "*"
   
   If ファイル拡張子 = 拡張子 Then
     ファイル = ファイル + 1
     For i = 0 To 40
       データ(ファイル, i) = objFolder.GetDetailsOf(strFileName, i)
     Next
    End If
  Next

  ThisWorkbook.Worksheets(追加シート名).Activate
  Application.ScreenUpdating = True

  For 行 = 0 To ファイル
    For 列 = 0 To 40
      ThisWorkbook.Worksheets(追加シート名).Range("A2").Cells(行 + 1, 列 + 1) _
      = データ(行, 列)
    Next 列
  Next 行

End Sub

【76334】Re:「サブフォルダ内ファイルのプロパテ...
発言  マルチネス  - 14/11/1(土) 7:42 -

引用なし
パスワード
   >VBA質問箱基本ポリシー

マルチポストについて
別のサイト(掲示板)にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。当質問箱では、マルチポストは原則認めています。つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

【76335】Re:「サブフォルダ内ファイルのプロパテ...
お礼  おさむ  - 14/11/1(土) 9:42 -

引用なし
パスワード
   マルチネスさま
はじめまして、おはようございます。

ご返信、ありがとうございました。
このような質問掲示板を利用することが初めての私に、「マルチポスト」について丁寧にご解説いただき、大変勉強になりました。

ただ、最初の質問内容については未だ解決しておりません。
どうぞご教示のほど、よろしくお願いいたします。

【76342】Re:「サブフォルダ内ファイルのプロパテ...
発言  カリーニン  - 14/11/1(土) 20:39 -

引用なし
パスワード
   >web上の作例を参考に

差支えなければ、参考にしたWEBページのURLをアップしてみてください。

※ここは直接リンク出来ないので

ht tp://〜
のようにhtとtpの間の開けるなどして貼り付けてください。

【76345】Re:「サブフォルダ内ファイルのプロパテ...
回答  おさむ  - 14/11/1(土) 21:51 -

引用なし
パスワード
   カリーニン様
ご返信ありがとうございます。

ただ今、参考web「パソコン便利ツール集」の管理人者様にアドバイスをいただき試行錯誤しているところですが、何分vbaの知識が0に等しい状態なので…

以下が参考webのURLです。
ht tp://makoto-watanabe.main.jp/vba_file3.html#FileProperty

そして、以下を参考に、上記URLのものに再帰処理を追加してみるようアドバイスいただいたものの、苦戦しております。
ht tp://makoto-watanabe.main.jp/vba_file4.html#FileSystemObject

勝手なお願いではございますが、お力添え、よろしくお願いします。

【76349】Re:「サブフォルダ内ファイルのプロパテ...
発言  カリーニン  - 14/11/1(土) 23:24 -

引用なし
パスワード
   >ただ今、参考web「パソコン便利ツール集」の管理人者様にアドバイスをいただき試行錯誤しているところですが、何分vbaの知識が0に等しい状態なので…

>そして、以下を参考に、上記URLのものに再帰処理を追加してみるようアドバイスいただいたものの、苦戦しております。

現在アドバイスに従い試行錯誤中でしたら私の出る幕は無いですね。
私のレスはこれまでとさせていただきます。

【76350】Re:「サブフォルダ内ファイルのプロパテ...
お礼  おさむ  - 14/11/1(土) 23:30 -

引用なし
パスワード
   こんばんは。
あれからずっと試行錯誤中、と申しますか暗中模索な状態で未だ解決しておりません。
ただ、あまりお手を煩わせてしまうのも申し訳ございませんし…
ご返信いただきました事、本当に感謝しています。

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

【76378】Re:「サブフォルダ内ファイルのプロパテ...
回答  渡辺真  - 14/11/10(月) 10:52 -

引用なし
パスワード
   とりあえず動きそうなものを作ったので、ご参考までに。

指定フォルダの全てのファイルのプロパティを出力(サブ・フォルダ以下も含む)
makoto-watanabe.main.jp/vba_file3.html#FilePropertyIncludeSubfolders

オブジェクトを使ったマクロは、難しいですね。

1089 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free