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

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

解決済みの質問

最終保存日時の表示方法について

現在、下記のようなマクロで指定ディレクトリ内のフォルダ名を検索し、A3から下に標記
取得したフォルダ名の中にある「いろは.XLS」の「C9」の値をB3から下に標記
としております。「いろは.XLS」が必ずあるという前提でのマクロです。
Sub main()
Const myPath As String = "D:\テスト\"
Dim myFolder As String
myFolder = Dir(myPath, vbDirectory)

Dim r As Integer
r = 3
Do While myFolder <> ""
If myFolder <> "." And myFolder <> ".." Then
If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then
Cells(r, 1).Value = myFolder
Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[いろは.XLS]Sheet1 '!R9C3")
r = r + 1

End If
End If
myFolder = Dir
Loop

End Sub

今回、C3から下に”各フォルダ内の「いろは.XLS」の最終保存日時”を標記し、「いろは.XLS」がない場合、ファイル名だけ取得したいのですが、どのようにすれば可能でしょうか?

ExecuteExcel4Macroについてはファイルを開かないで操作するそうなのですが、サイトのコピペで造っていくしかまだ出来ない知識ですので、この形になっております。

投稿日時 - 2012-02-21 10:56:51

QNo.7318161

暇なときに回答ください

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

Sub macro1()
 Dim myPath As String
 Dim myFolder As String
 Dim r As Long

 r = 3
 myPath = "D:\テスト\"
 myFolder = Dir(myPath, vbDirectory)

 Do Until myFolder = ""
  If myFolder <> "." And myFolder <> ".." Then
  If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then
   Cells(r, 1) = myFolder

  ’最終更新日の取得
   On Error Resume Next
   Cells(r, 3) = FileDateTime(myPath & myFolder & "\いろは.xls")
   On Error GoTo 0

  ’セルの値の取得
   Application.DisplayAlerts = False
   Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[いろは.XLS]Sheet1'!R9C3")
   Application.DisplayAlerts = True

  ’ファイルが入ってなかった場合
   If Cells(r, 3) = "" Then
    Cells(r, 2) = "いろは.xls"
   End If
   r = r + 1
  End If
  End If
  myFolder = Dir()
 Loop
End Sub

みたいな。

投稿日時 - 2012-02-21 11:51:30

お礼

早々にお返事を頂きありがとうございます。
Application.DisplayAlerts = False
   Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[いろは.XLS]Sheet1'!R9C3")
   Application.DisplayAlerts = True
の部分なのですが、ExecuteExcel4MacroがApplication.DisplayAlertsの代役をしてくれるようなコマンドなので省かさせて頂き、無事マクロを走らせることができました。
FileDateTimeの標記を書式設定してm月で使えるように編集できれば目指す形にすることが可能です。
この度は本当にありがとうございました。

投稿日時 - 2012-02-21 13:16:29

ANo.1

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

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

回答(1)

あなたにオススメの質問