Перенос файла из одной папки в другую

[Amelie_L]

У меня есть программа, она формирует файлы и сохраняет их в опред папке, файлы формируются каждый день. Как можно написать макрос (или дописать мой) который бы проверял дату создания файлов в этой папке и если с момента создания прошла например неделя, то переносил их в другую папку (что то типо архива)?

[Maxx]

Вот код:

Sub movingFiles()
Dim filePath As String, arhPath As String, fileName As String, crDate As Variant
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFL
      
filePath = ThisWorkbook.path & "\"
arhPath = ThisWorkbook.path & "\Архив\"
     
fileName = Dir(filePath & "*.xls") 'проверять будем файлы Эксель. Можно изменить расширение
    Do While fileName <> ""
        Set objFL = objFSO.GetFile(filePath & fileName)
        crDate = objFL.DateCreated
            timeToMove = crDate + 7 'прибавляем 7 дней к дате создания
            If Now > timeToMove Then objFSO.MoveFile filePath & fileName, arhPath & fileName
    fileName = Dir
    Loop

    
Set objFSO = Nothing

MsgBox "Готово!"
End Sub

Файлы, которые надо перенести, должны лежать в той же папке, что и Ваш файл. В этой папке создайте папку "Архив", туда и будут закидываться файлы через неделю после их создания.
Код можно поместить в модуль и запускать по необходимости, а можно поместить в модуль ЭтаКнига и запускать при собитии открыттия книги

Sub Workbook_Open()

[Amelie_L]

Дело в том что если этот файл будет лежать там же где и мои, то программа при запуске, через неделю тоже отправляет его в архив)Может можно как то место прописать?

[istoe]

в коде выше:

    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name Then
            Set objFL = objFSO.GetFile(filePath & fileName)
            crDate = objFL.DateCreated
                timeToMove = crDate + 7 'прибавляем 7 дней к дате создания
                If Now > timeToMove Then objFSO.MoveFile filePath & fileName, arhPath & fileName
        End If
        fileName = Dir
    Loop

[Maxx]

If fileName <> ThisWorkbook.Name Then

Все правильно! Писал быстро, не обратил внимания.
Но в любом случае вылезла бы ошибка, так как открытый файл не переместился бы.

[EducatedFool]

Перемещать файл можно и без использования CreateObject("Scripting.FileSystemO bject").

Достаточно будет встроенных средств VBA:

Sub test()
    СтарыйПутьКФайлу = "C:\Documents and Settings\Рабочий стол\Clip_3.jpg"
    НовыйПутьКФайлу = "D:\картинки\Новое Имя.jpg"
    Name СтарыйПутьКФайлу As НовыйПутьКФайлу
End Sub

[Maxx]

Сообщение от EducatedFool

Перемещать файл можно и без использования CreateObject("Scripting.FileSystemO bject").

Достаточно будет встроенных средств VBA:

Sub test()
    СтарыйПутьКФайлу = "C:\Documents and Settings\Рабочий стол\Clip_3.jpg"
    НовыйПутьКФайлу = "D:\картинки\Новое Имя.jpg"
    Name СтарыйПутьКФайлу As НовыйПутьКФайлу
End Sub

Увы, но на моем уровне такой способ - это что-то из рода фантастики

Сорри за флуд!