• ベストアンサー

サブフォルダを含めた最新のエクセルを取得したいです

VBA初心者です。 ①サブフォルダを含めた最新更新日のエクセルファイルを取得したいです。 ②そして、最新更新日のエクセルファイルは、そのエクセルが入っていたフォルダの名前に変更し、別フォルダへコピーしたいです。 お手数ですが、ご教授ください。

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

  • ベストアンサー
  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.5

xlsxに限定してみました。 Option Explicit Dim HitDate As Date Dim HitFile As String Dim HitPath As String Const Putfolder = "C:\testX" Sub sample()    HitDate = 0  HitFile = ""  GetFileName "C:\Users\papa\Desktop\MyTest\test"    FileCopy HitPath, _   Putfolder & "\" & getLastPath(HitPath) & "." & getFileType(HitFile)   End Sub Sub GetFileName(strPath As String)    Dim tSfo As Object  Dim tGf As Object  Dim tFi As Object  Dim tSub As Object     Set tSfo = CreateObject("Scripting.FileSystemObject")  Set tGf = tSfo.GetFolder(strPath)  For Each tFi In tGf.Files   If Right(tFi.Name, 5) = ".xlsx" Then '//この行を追加    If HitDate < tFi.DateLastAccessed Then     HitDate = tFi.DateLastAccessed     HitPath = tFi.Path     HitFile = tFi.Name    End If   End If                '//この行を追加  Next    For Each tSub In tGf.SubFolders   GetFileName tSub.Path  Next    End Sub '最下層のフォルダー名を取得 Function getLastPath(FPath As String) As String  Dim HitPos As Long  Dim WkStr1 As String  Dim WkStr2 As String    WkStr1 = FPath    Do       HitPos = InStr(1, WkStr1, "\")   If HitPos = 0 Then Exit Do   If HitPos > 0 Then    WkStr2 = WkStr1    WkStr1 = Mid(WkStr1, HitPos + 1, Len(FPath))   End If  Loop    HitPos = InStr(1, WkStr2, "\")  getLastPath = Mid(WkStr2, 1, HitPos - 1) End Function 'ファイルの拡張子を取得 Function getFileType(FName As String) As String  Dim HitPos As Long  Dim WkStr1 As String    WkStr1 = FName    Do   HitPos = InStr(1, WkStr1, ".")   If HitPos = 0 Then Exit Do   If HitPos > 0 Then    WkStr1 = Mid(WkStr1, HitPos + 1, Len(WkStr1))   End If  Loop    getFileType = WkStr1 End Function

その他の回答 (4)

  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.4

よかったら試してみてください。 サブフォルダーも含めて検索します。 また、エクセルファイル以外のファイルがあり、 それが最新であれば、そのファイルを複写しています。 もし、エクセルファイルだけに限定するのであれば 対象となる拡張子を限定列挙してください。 また、簡単な動作テストしか行っていません。 間違い、期待外の個所があれば指摘してください。 Option Explicit Dim HitDate As Date Dim HitFile As String Dim HitPath As String Const Putfolder = "C:\testX" Sub sample()    HitDate = 0  HitFile = ""  GetFileName "C:\MyTest\test"    FileCopy HitPath, _   Putfolder & "\" & getLastPath(HitPath) & "." & getFileType(HitFile)   End Sub Sub GetFileName(strPath As String)    Dim tSfo As Object  Dim tGf As Object  Dim tFi As Object  Dim tSub As Object     Set tSfo = CreateObject("Scripting.FileSystemObject")  Set tGf = tSfo.GetFolder(strPath)  For Each tFi In tGf.Files   If HitDate < tFi.DateLastAccessed Then    HitDate = tFi.DateLastAccessed    HitPath = tFi.Path    HitFile = tFi.Name   End If  Next    For Each tSub In tGf.SubFolders   GetFileName tSub.Path  Next    End Sub '最下層のフォルダー名を取得 Function getLastPath(FPath As String) As String  Dim HitPos As Long  Dim WkStr1 As String  Dim WkStr2 As String    WkStr1 = FPath    Do       HitPos = InStr(1, WkStr1, "\")   If HitPos = 0 Then Exit Do   If HitPos > 0 Then    WkStr2 = WkStr1    WkStr1 = Mid(WkStr1, HitPos + 1, Len(FPath))   End If  Loop    HitPos = InStr(1, WkStr2, "\")  getLastPath = Mid(WkStr2, 1, HitPos - 1) End Function 'ファイルの拡張子を取得 Function getFileType(FName As String) As String  Dim HitPos As Long  Dim WkStr1 As String    WkStr1 = FName    Do   HitPos = InStr(1, WkStr1, ".")   If HitPos = 0 Then Exit Do   If HitPos > 0 Then    WkStr1 = Mid(WkStr1, HitPos + 1, Len(WkStr1))   End If  Loop    getFileType = WkStr1 End Function

tamanoyama
質問者

補足

ありがとうございます。 拡張子は、.xlsxです。他のファイルは、対象外にしたいです。 お手数ですが、宜しくお願いします!

  • SI299792
  • ベストアンサー率47% (772/1616)
回答No.3

画像の様に B1: 入力フォルダ B2: 出力フォルダ を指定して下さい。 1階層しか見ません。サブフォルダの下のフォルダは無視されます。 Option Explicit ' Sub Macro1()   Dim Path As Object   Dim FileName As String   Dim MaxName As String   Dim MaxDateTime As Date   Dim NowDateTime As Date   Dim Start1 As Integer   Dim Start2 As Integer '   For Each Path In _     CreateObject("Scripting.FileSystemObject").GetFolder([B1]).SubFolders     MaxDateTime = 0     FileName = Dir(Path.Path & "\*.xls*") '     Do While FileName > ""       NowDateTime = FileDateTime(Path.Path & "\" & FileName) '       If MaxDateTime < NowDateTime Then         MaxDateTime = NowDateTime         MaxName = FileName       End If       FileName = Dir     Loop '     If MaxDateTime > 0 Then       Start1 = InStrRev(Path.Path, "\") + 1       Start2 = InStr(MaxName, ".")       FileCopy Path.Path & "\" & MaxName, _         [B2] & "\" & Mid(Path.Path, Start1) & Mid(MaxName, Start2)     End If   Next Path End Sub

tamanoyama
質問者

補足

ご回答いただき、ありがとうございます! やりたいことにかなり近いです! ただ、これを動かしますと、最新の更新日のxlsだけではなく、サブフォルダにある※xls全てが抽出されてしまいました。 最新更新日だけを抽出したいのですが、どうやったらできるのか、お手数ですが、ご教授願えませんでしょうか?

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.2

VBA初心者には、すぐには、無理でしょう。 (1)ローカルのパソコンの、フォルダだけの話か?    最近は「クラウド」に、ファイルを置くのも多いようだが。 (2)VBAの学習分野ではあると思うが、VBScriptという分野がある。ファイル、フォルダ、サブフォルダなどを問題にするなら、VBSCRIPTの勉強をした方がよい。それには多少時間が掛かる。存在ぐらい知っているか?他に、DOSコマンド由来のDirなどをVBAでも使えるが、VBScriptでやる方が、すっきりすると思う。 (3)ファイル、フォルダ、サブフォルダの構成は、ツリー構造になっている。このことを知っているか?だから、それをたどるには、Recursiveの考えと、そのプログラムのやり方が出てくる。それでやるのが普通かもしれない。 しかしすぐには、難しいから、一番上の、エクセルファイルのありそうな、フォルダ名をまず掴む。その名前をシートの決めた列のセルに記録する。 そしてその1つのフォルダ名(親)について、その各フォルダ名の配下のフォルダ名(子)やファイル名(子)を、独立したモジュールの事項で、シートに書き上げる。 「深さ」(親ー子ー孫ー・・)は理論的に相当可能だが、子フォルダぐらいで、「葉」のファイル名に行き着くのではないかな。 (Googleで「木構造」で照会。根、ノード、葉、深さ、深さ優先などの術語の理解。) 中身を調べるだけなら(リカーシブなどの技法の習得を急がないなら)そういう方法を勧める。 ーー むしろ、上記のような構造を「ノード」名を図示(表示)してくれるソフトを探して、使ってはどうか。 Googleで「ファイル ツリー表示 ソフト」で照会。Vectorなどにそういうソフトがある。 またコードについても、Googleで「VBA ファイル ツリー表示」で照会したら記事がある。 ーー 質問者の、今の一番の問題点は、そういう照会を、まずしよう、それでまず勉強しようと、してないことにあると思う。WEBには、ほとんどの問題の解説とコードが見つかると思って探すべきだ。 質問コーナーの回答に安直に頼るな。 ーーー Googleで「VBA ファイル Recursive」で照会。 最初の記事 https://excel-vba.work/2020/10/30/%E3%80%90vba%E3%80%91%E3%80%90%E5%86%8D%E5%B8%B0%E3%80%91%E6%8C%87%E5%AE%9A%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E9%85%8D%E4%B8%8B%EF%BC%88%E3%82%B5%E3%83%96%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80/ VBA】【再帰】指定フォルダ配下(サブフォルダ含む)の全てのExcelファイルに対して、処理を行う

  • tkf-
  • ベストアンサー率58% (821/1398)
回答No.1

会社のファイルサーバーなどで管理されているのでしょうか。 VBAでゴリゴリ組むことも可能かもしれませんが、そのフォルダの管理方法について管理者の方とご相談されたほうがいいのではと思います。 ・最新版を意識しないで済み、過去バージョンなど履歴が保存できる仕組み ・プログラムで組みたいのであれば、それがしやすいように あなたがいなくなったらメンテできない仕組みを作るべきではないです。

関連するQ&A