Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : 指定なし)
指定フォルダ内最新ファイル名の転記(連続)方法について
投稿日時: 20/08/14 16:34:07
投稿者: vicky_T

勉強不足で申し訳ありません
繰り返し処理について教えてください。
 
列B8〜にフォルダ保存バスが入っています。
列C8〜に列Bで指定したフォルダに存在するファイルの内
最新(直近に作成された)のファイル名を
表示させたいといろいろなサイトを検索して
以下を作りました。
 
Sub ファイル名転記()
Dim fso, fol, fc, f1, f2
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder(Cells(8, 2))
Set fc = fol.Files
 
For Each f1 In fc
If IsEmpty(f2) = True Then
 Set f2 = fso.GetFile(f1)
End If
If f1.DateLastModified > f2.DateLastModified Then
 Set f2 = fso.GetFile(f1)
End If
Next
 Cells(8, 3).Value = f2.Name
End Sub
 
これをB列にデータがあれば全てのC列に自動的にデータが転記されるようにしたいと
以下のとおり作ってみましたが、全く反応しませんでした、
どのように作り替えればよいのか、どなたかご教授頂けませんでしょうか。
どうぞよろしくお願いします。
 
Sub 連続ファイル名転記()
Dim i As Long
Dim MaxRow As Long
MaxRow = Sheets("添付書類").Cells(Rows.Count, 2).End(xlUp).Row
 
For i = 1 To MaxRow
Dim fso, fol, fc, f1, f2
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder(Cells(i, 2))
Set fc = fol.Files
For Each f1 In fc
If IsEmpty(f2) = True Then
Set f2 = fso.GetFile(f1)
End If
If f1.DateLastModified > f2.DateLastModified Then
Set f2 = fso.GetFile(f1)
End If
Next
Cells(i, 3).Value = f2.Name
Next i
End Sub    

回答
投稿日時: 20/08/14 16:57:25
投稿者: simple

こんにちは。
 
ファイル名と更新年月日時刻をワークシートに取得して、
後者で降順にソートすればいいんじゃないでしょうか。

回答
投稿日時: 20/08/15 10:43:48
投稿者: simple

最新の更新日時のファイルをひとつだけ抽出するということでしたか。
それなら、下記をたたき台にしてください。
 

Sub 連続ファイル名転記()
    Dim ws As Worksheet
    Dim fso As Object
    Dim fol, fc, f, flatest 'ここの型宣言は適当です。
    Dim i As Long
    Dim MaxRow As Long

    Set ws = Sheets("添付書類")
    MaxRow = ws.Cells(Rows.count, 2).End(xlUp).Row
    Set fso = CreateObject("Scripting.FileSystemObject")

    For i = 1 To MaxRow
        Set fol = fso.GetFolder(ws.Cells(i, 2).Value)
        Set flatest = Nothing
        Set fc = fol.Files
        For Each f In fc
            If flatest Is Nothing Then
                Set flatest = f
            End If
            If f.DateLastModified > flatest.DateLastModified Then
                Set flatest = f
            End If
        Next
        ws.Cells(i, 3).Value = flatest.Name
    Next i
End Sub

回答
投稿日時: 20/08/18 12:14:59
投稿者: simple

>全く反応しませんでした、
フォルダパスが正確にセルに入力されていれば、なんらかのファイルは取得するはずです。
ステップ実行して動作確認してみてはどうですか?
そうすれば、コードが何をしているかも、もっと理解が進むはずです。
 
ポイントは、フォルダ毎に最新更新日時のファイルを取得するところで、
提示されたコードでは、フォルダ毎にf2が初期化されていないので、
前のフォルダでの情報が残ってしまっているのが、所期する結果を得られない原因です。
 
なお、細かい話ですが、
Set f2 = fso.GetFile(f1)
という書き方に関してコメントしておきます。
・f1が既にファイルオブジェクトなので、
  改めてfso.GetFile(f1)とする必要はないと思います。
・もっとも、ファイルオブジェクトの既定のプロパティがPathなので、
  Set f2 = fso.GetFile(f1.Path)
  と書いているのと同じで、f2がファイルオブジェクトになることはなりますが、
  それは無駄ともいえます。
・Set f2 = f1 で OKです。

回答
投稿日時: 20/08/21 10:39:49
投稿者: simple

こちらには返事もせずに、別の質問掲示板に8/17に同一質問されていますね。
こちらの回答を無視する理由がわかりません。残念です。

投稿日時: 20/08/23 17:25:04
投稿者: vicky_T

simple 様
 
早くにご回答いただいていたのにお礼が遅くなり申し訳ありません。
ほかの方も同じような投稿をされていたのでしょうか?
回答を確認することが頻繁にできない環境のため、
お礼が遅くなり誤解をされることになったようですみませんでした。
 
考えていただいた内容でほぼ希望の結果が得られました。
ただ、列Bに指定したフォルダー内にファイルがない場合があり、
その場合、そこで抽出が止まってしまいました。
 
指定フォルダーにファイルがない場合は飛ばして、
次の行以降抽出を続けるにはどうるればよいか教えていただけますでしょうか。
よろしくお願いします。

回答
投稿日時: 20/08/23 18:16:39
投稿者: simple
回答
投稿日時: 20/08/24 10:43:49
投稿者: Suzu

vicky_T さん、simpleさんがおっしゃっているのは、
 
ここで回答が得られているのに、他サイトへ同様のご質問をされていませんか?
という事です。
 
 

引用:
ただ、列Bに指定したフォルダー内にファイルがない場合があり、
その場合、そこで抽出が止まってしまいました。
 
指定フォルダーにファイルがない場合は飛ばして

ファイルがあるか無いかは、
 
 For Each f In fc の直後に、fc.Coun の値にて
処理するかしないか判断 すれば良いと思いますよ。

回答
投稿日時: 20/08/27 19:07:10
投稿者: mattuwan44

>その場合、そこで抽出が止まってしまいました。
 
プログラムが途中で止まって、「デバッグしますか?」となってしまったということですね?
そういう場合は、
その時のエラー番号やエラーメッセージ、
「デバッグしますか?」で「はい」を選んでVBEの画面に戻ったときに、
黄色く反転している行を書いてください。
 
不具合がある個所のヒントになりますので。(エラーメッセージってそういう目的で出ると思いますが?)
 
フォルダー内にファイルがない場合は、
flatestがNothing(=何もない)のままなので、
flatest.Nameと何もないものの名前を取得することになるので、
オブジェクトの定義エラーになります。
そのエラーを回避するには変数が空かどうかを確認して条件分岐して処理します。
 
 

Option Explicit

'※Microsoft Scripting Runtimeの参照設定を行うこと

Dim mFSO As FileSystemObject

Sub test()
    Dim rngTop As Range
    Dim rngBottom As Range
    
    Set mFSO = New FileSystemObject
    Set rngTop = Range("B8")
    Set rngBottom = Cells(Rows.Count, "B").End(xlUp)
    
    If rngBottom.Row < rngTop.Row Then Exit Sub
    
    For Each c In Range(rngTop, rngBottom)
        c.Offset(, 1).Value = GetLastestFileName(c.Value)
    Next
End Sub

Function GetLastestFileName(ByVal sPath As String) As Variant
    Dim objFolder As Folder
    Dim f As File
    Dim objResult As File
    
    Set objFolder = mFSO.GetFolder(sPath)
    
    'フォルダー内のファイル群に対し繰り返し
    For Each f In objFolder.Files
        If objResult Is Nothing Then
            Set objResult = f
        ElseIf objResult.DateLastModified < f.DateLastModified Then
            Set objResult = f
        End If
    Next
    
    If objResult Is Nothing Then
        GetLastestFileName = Empty
    Else
        GetLastestFileName = objResult.Name
    End If
End Function

 
参考URL>>
https://www.relief.jp/docs/fso-vba-references.html
http://officetanaka.net/excel/vba/filesystemobject/
 
 
最後になりましたが、1つが処理できるプロシージャができたなら、
それを再利用することを覚えましょう。
あと、
「オブジェクト」や「コレクション」という概念についても、
今一度、理解を深めた方がよいかも知れません。
 

投稿日時: 20/08/30 16:42:20
投稿者: vicky_T

simple 様
 
参考先、見ました。
確かに同じ投稿ですね。
ただ、私はこちら以外で投稿したことありませんので
何故なのか不明です。

投稿日時: 20/08/30 16:43:57
投稿者: vicky_T

Suzu 様
 
アドバイスありがとうございました。

投稿日時: 20/08/30 16:50:35
投稿者: vicky_T

mattuwan44 様
 
testを実行したところ
cの変数が定義されていません。
とエラーメッセージがでました。
 
どのように対処すればよいか教えていただけますでしょうか。
よろしくお願いします。

回答
投稿日時: 20/08/30 21:39:40
投稿者: simple

> 参考先、見ました。
> 確かに同じ投稿ですね。
> ただ、私はこちら以外で投稿したことありませんので
> 何故なのか不明です。

ああ、そうなんですか、不思議なこともあるものですね。
あなたじゃないなら、気兼ね無く言えますね。
 
他人の投稿を、また別のところに質問して、何を考えているんでしょうね。
いったい、その人にどんなメリットあるんですかね。
しかも、17日には動作する回答がついていたわけで、
そのかたは、それをまったく理解せずに別の投稿するなど、
まったくもって間抜けな人ですね。
わざわざご報告ありがとうございました。
 
 
ちなみに、Suzuさんのコメントですが、
fc.Counはfc.Countのタイプミスと思います。
フォルダ配下のファイル数を表すものですね。老婆心ながら。

回答
投稿日時: 20/08/31 11:03:38
投稿者: Suzu

simple さんの引用:
Suzuさんのコメントですが、
fc.Counはfc.Countのタイプミスと思います。
フォルダ配下のファイル数を表すものですね。老婆心ながら。

 
フォローありがとうございます。
タイプミスでした。
 
全体感としては
--------------------------------------------------------------
Sub 連続ファイル名転記()
 Dim ws As Worksheet
 Dim fso As Object
 Dim fol, fc, f, flatest 'ここの型宣言は適当です。
 Dim i As Long
 Dim MaxRow As Long
 
 Set ws = Sheets("添付書類")
 MaxRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
 Set fso = CreateObject("Scripting.FileSystemObject")
 
 For i = 1 To MaxRow
  If fso.FolderExists(ws.Cells(i, 2).Value) Then
   ws.Cells(i, 3).Value = Empty

   Set fol = fso.GetFolder(ws.Cells(i, 2).Value)
   Set flatest = Nothing
   Set fc = fol.Files
   If fc.Count > 0 Then
    For Each f In fc
     If flatest Is Nothing Then
      Set flatest = f
     End If
     If f.DateLastModified > flatest.DateLastModified Then
      Set flatest = f
     End If
    Next
    ws.Cells(i, 3).Value = flatest.Name
   End If
  End If
 Next i
End Sub
--------------------------------------------------------------
こんなイメージでした。
(赤の部分は、B列の値のフォルダが存在するかどうかの確認をしてから「fol」を取得しています)
 
コードが止まるのは、フォルダ内にファイルが存在しない場合に
 ws.Cells(i, 3).Value = flatest.Name の部分で
 flatest がNothing にも関わらず Nameプロパティーを参照しようとするのでエラーになります。
 
 ですので、緑の部分は、以下でも可能です。
 For i = 1 To MaxRow
  If fso.FolderExists(ws.Cells(i, 2).Value) Then
   ws.Cells(i, 3).Value = Empty
   Set fol = fso.GetFolder(ws.Cells(i, 2).Value)
   Set flatest = Nothing
   Set fc = fol.Files
    For Each f In fc
     If flatest Is Nothing Then
      Set flatest = f
     End If
     If f.DateLastModified > flatest.DateLastModified Then
      Set flatest = f
     End If
    Next
If Not flatest Is Nothing Then
     ws.Cells(i, 3).Value = flatest.Name
    End If

  End If
 Next i
 
コードを書く以上
flatest がNothing にも関わらず Nameプロパティーを参照しようとするのでエラーになります。
これを自分で気付ける様にならないと問題が発生した際に対応できなくなります。
 
少なくとも、エラーが起きたなら、止まっているいる位置のコードは判るはずですから
ローカルウィンドにて、その部分のコードの変数を確認すれば直接の原因は確認できます。
(今回の場合は、flatest が Nothing であるが原因)
 
ではその原因が何故発生するのかを考察し
原因を発生させないためにはどうするか?
(今回は Count>0にて、ファイルがある場合のみ、flatest の処理を行う)
或いは 原因は発生してしまうもの。発生してしまっても問題が無いように処理させる
(今回は flatest が Nothingであるかどうかを判定し、flatest を参照する処理をしない)
 
の様に対応します。
 
そのために、ローカルウィンドを使うことは必須になります。
使い方を確認してください。

回答
投稿日時: 20/09/01 16:43:51
投稿者: mattuwan44

引用:
mattuwan44 様
  
testを実行したところ
cの変数が定義されていません。
とエラーメッセージがでました。
  
どのように対処すればよいか教えていただけますでしょうか。
よろしくお願いします。

 
失礼しました。行き当たりばったりで書いて、
コンパイルも試してな勝手です。
 
プロシージャのどこかに
 
dim c as range
 
と変数の宣言をしてください。

投稿日時: 20/09/07 01:11:20
投稿者: vicky_T

皆様
 
アドバイスいただきありがとうございます。
皆様の丁寧なコメントを参考にさせていただき
希望の処理を完成することができました。
 
ご親切に教えていただき感謝致しております。