仕事で、ある機器の検証をしています。
検証テストをするときに使用するファイルが、「Aフォルダ」に140ファイルあります。（ファイル名「101_○○○.xls～240_○○○.xls」）
↓
検証テストは、1ファイルずつ複数人で行います。
↓
検証テストが終了したファイルは、Aフォルダから「B・C・Dフォルダ」のいずれかに切り取り移動されます。
↓
ということで、移動されてしまったファイルは、Aフォルダ内を検索しても、#REF!と表示されてしまいます。
出来ていること
(1)ファイルの所在検索マクロの組立て
(2)Aフォルダ内にすべての140ファイルがあった場合のF列コピーマクロの組立て
※A,B,C,Dフォルダは、同フォルダ内、同階層にあります。
※すべてのフォルダは、会社のネットワークドライブ上にあります。
※Aフォルダ内のファイルは、最終的に0になります。
※各ファイルがA・B・C・Dフォルダのいずれに保存されているかは「ファイル所在検索マクロ」を実行しないと分かりません。
可能がどうか知りたいこと！！
ファイルの所在検索マクロから確認できたファイルの所在（ハイパーリンク付）＆ファイル名から、ファイルを特定して、F列のコピーができるか？
「まとめのエクセルファイル」は、5シート構成です。
Sheet1…進捗＆担当者一覧
Sheet2…101～240チェック_詳細結果
Sheet3…301～440チェック_詳細結果
Sheet4…501～640チェック_詳細結果
Sheet5…ファイル所在検索を求めるためのシート
上記の「Sheet2…101～240チェック_詳細結果」にマクロを入れたい。現状、このようになっています。
A B C D E F G H …列
ファイル名→→ 101 102 103 104 105 106 …
求めたい値 1 OK OK NG OK NG
↓ 2 NG OK NG OK OK
↓ 3 OK OK NG OK OK
↓ 4 OK OK NG NG OK
(行)
※列…ファイル名
※行…各ファイルのF8:F57に表示される値
※C列には、101_○○○.xlsのF8:F57の値をコピーしたいです。
D列には、102_○○○.xlsのF8:F57の値をコピーしたいです。
質問がややこしいですが、ぜひお願いします！！
mitarashiさん、レスが遅くなり、すみません。
返信ありがとうございます！
まずは、ファイルの所在検索は↓
--------------------------------
Sub ファイル所在検索()
Dim vntF As Variant
Dim objFS As FileSearch
Dim objFSO As FileSystemObject
Dim dteDate As Date
Dim GYO As Long
Dim cntFound As Long
Set objFS = Application.FileSearch ' FileSearch
Set objFSO = New FileSystemObject ' FSO
Rows("5:65536").ClearContents
GYO = 4
With objFS
.NewSearch
.LookIn = Trim(Cells(1, 2).Value) ' Search開始フォルダ
.Filename = Trim(Cells(2, 2).Value) ' 探索ファイル式
dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date)
.SearchSubFolders = True ' サブフォルダも探索
' 処理開始
If .Execute() <> 0 Then
' 見つかったファイル分のループ
For Each vntF In .FoundFiles
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
' ↓↓↓この間が見つかったファイルに対する処理↓↓↓
' FSOにてファイルを取得
With objFSO.GetFile(vntF)
' 今回は、最終更新日を確認し、該当ならシートの表示
If .DateLastModified >= dteDate Then
GYO = GYO + 1
Cells(GYO, 1).Value = _
Left(.Path, Len(.Path) - Len(.Name) - 1)
cntFound = cntFound + 1
Cells(GYO, 2).Value = .Name
Cells(GYO, 3).Value = .DateLastModified
End If
End With
' ↑↑↑この間が見つかったファイルに対する処理↑↑↑
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Next vntF
End If
End With
Set objFS = Nothing
Set objFSO = Nothing
' 処理結果の表示
If cntFound = 0 Then
MsgBox "見つかりません"
Else
MsgBox cntFound & "個見つかりました"
End If
End Sub
----------------------------------
このようなコードを入れています。
mitarashiさんが貼り付けてくださっていた
参考URLのマクロと同じようなコードです。
もう一つのURLから、こちらを見つけました！
http://oshiete1.goo.ne.jp/qa2406030.html
参考になるコードがありましたので、明日試してみます！
ありがとうございます。
補足
mitarashiさん、レスが遅くなり、すみません。 返信ありがとうございます！ まずは、ファイルの所在検索は↓ -------------------------------- Sub ファイル所在検索() Dim vntF As Variant Dim objFS As FileSearch Dim objFSO As FileSystemObject Dim dteDate As Date Dim GYO As Long Dim cntFound As Long Set objFS = Application.FileSearch ' FileSearch Set objFSO = New FileSystemObject ' FSO Rows("5:65536").ClearContents GYO = 4 With objFS .NewSearch .LookIn = Trim(Cells(1, 2).Value) ' Search開始フォルダ .Filename = Trim(Cells(2, 2).Value) ' 探索ファイル式 dteDate = DateAdd("m", Cells(3, 2).Value * -1, Date) .SearchSubFolders = True ' サブフォルダも探索 ' 処理開始 If .Execute() <> 0 Then ' 見つかったファイル分のループ For Each vntF In .FoundFiles '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' ↓↓↓この間が見つかったファイルに対する処理↓↓↓ ' FSOにてファイルを取得 With objFSO.GetFile(vntF) ' 今回は、最終更新日を確認し、該当ならシートの表示 If .DateLastModified >= dteDate Then GYO = GYO + 1 Cells(GYO, 1).Value = _ Left(.Path, Len(.Path) - Len(.Name) - 1) cntFound = cntFound + 1 Cells(GYO, 2).Value = .Name Cells(GYO, 3).Value = .DateLastModified End If End With ' ↑↑↑この間が見つかったファイルに対する処理↑↑↑ '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Next vntF End If End With Set objFS = Nothing Set objFSO = Nothing ' 処理結果の表示 If cntFound = 0 Then MsgBox "見つかりません" Else MsgBox cntFound & "個見つかりました" End If End Sub ---------------------------------- このようなコードを入れています。 mitarashiさんが貼り付けてくださっていた 参考URLのマクロと同じようなコードです。 もう一つのURLから、こちらを見つけました！ http://oshiete1.goo.ne.jp/qa2406030.html 参考になるコードがありましたので、明日試してみます！ ありがとうございます。