質問: Excel VBA の質問です。 特定のフォルダの中にある、 特定の拡張子、 最終保存日付が現在の年、月と同じ、 のファイルを、 特定のフォルダにコピーする というプログラムを教えていただきたいです。 よろしくお願いします。
回答: 以下のコードを標準モジュールにコピペしてマクロ登録して下さい。 1.最初に、コピー元のフォルダを選択するダイアログが開きます。 2.次いで、拡張子の入力を求めます。(ドット不要、ワイルドカード使用可) 3.次いで、コピー先のフォルダを選択するダイアログが開きます。 後は自動で 1.指定の拡張子 2.最終更新年月が今日の年月と同じ ファイルをコピーします。 ただし、コピー先に同名のファイルが既に存在した時は、上書きされます。 Sub Main() Dim FSO As Object Dim FileObj As Object Dim Ext, Nen, Tuki Dim FolderPathM, FolderPathS Set FSO = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path .AllowMultiSelect = False If .Show = True Then FolderPathM = .SelectedItems(1) & "\" Else Exit Sub End If End With Ext = InputBox("拡張子を入力(ワイルドカード使用可能)") If Ext = "" Then Exit Sub End If With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path .AllowMultiSelect = False If .Show = True Then FolderPathS = .SelectedItems(1) & "\" Else Exit Sub End If End With Nen = Year(Now) Tuki = Month(Now) For Each FileObj In FSO.getfolder(FolderPathM).Files If FSO.GetExtensionName(FileObj) Like Ext Then If Year(FSO.GetFile(FileObj).DateLastModified) = Nen Then If Month(FSO.GetFile(FileObj).DateLastModified) = Tuki Then FSO.GetFile(FileObj).Copy FolderPathS End If End If End If Next Set FSO = Nothing End Sub