Страницы: 1
RSS
Макрос копирования файлов из одной папки в другую с заменой файлов
 
Код
Sub DirCopy()
    Dim OldPath$, NewPath$, Shablon$, OnlyName$
    OldPath = "C:\Users\Aswerd_nout\Desktop\1"
    NewPath = "C:\Users\Aswerd_nout\Desktop\2"
    Shablon = "*.*"
    OnlyName = Dir(OldPath & Shablon, vbReadOnly + vbHidden + vbSystem)
    Do Until OnlyName = ""
        FileCopy OldPath & OnlyName, NewPath & OnlyName
        OnlyName = Dir
    Loop
End Sub
Добрый день.Нашел в свободном доступе код для переноса файлов из одной папки в другую.При выполнении макроса VBA выдаёт ошибку " File not found". Хотел применить код... не получилось  :(.Имена файлов и их расширения в исходной папке "C:\Users\Aswerd_nout\Desktop\1"  могут меняться. В идеале,конечно,конечную папку  "C:\Users\Aswerd_nout\Desktop\2" перед её заполнением необходимо очистить, или произвести копирование  с заменой файлов.
Прошу помощи .
 
 
Михаил Крыжановский, здравия. Как я понял, Вам нужно папку 2 удалить и сделать копию папки 1. Почитайте тут.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
JayBhagavan,спасибо за ссылку буду изчать,хотя без знаний VBA  будет сложновато  :)  А так да... нужно  удалить файлы из папки 2(или... не удалять, а произвести копирование файлов из папки1 в папку2 с их заменой при совпадении имён)  
 
Код
Sub jjj()
    s_sourse_dir = "D:\tmp\1"
    s_reserv_dir = "D:\tmp\2"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(s_sourse_dir) Then
        MsgBox "Нечего копировать."
        Exit Sub
    End If
    If FSO.FolderExists(s_reserv_dir) Then FSO.DeleteFolder s_reserv_dir, True
    FSO.CopyFolder s_sourse_dir, s_reserv_dir, True
End Sub
Меняйте пути на свои.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
JayBhagavan, Спасибо !! ...и небожители спускаются на землю :). Всё работает как часы ! Заранее извиняюсь за "простоту" следующих  тем с моей стороны.Спасибо!!  :)
 
Михаил Крыжановский, пожалуйста. Вы преувеличиваете. Рад. Не стОит - желательно задавать вопросы после того, как поиск не дал ответа или что-то в найденном не понятно (смело экспериментируйте на "кошках"). Пожалуйста.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Цитата
JayBhagavan написал:
Меняйте пути на свои.
Поменял пути на свои.
Т.е. пути активной открытой книги.
Код
Sub jjj()
    s_sourse_dir = ActiveWorkbook.Path & "\Проект.txt"
    s_reserv_dir = ActiveWorkbook.Path & "\ТЗ\Проект.txt"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(s_sourse_dir) Then
        MsgBox "Нечего копировать."
        Exit Sub
    End If
    If FSO.FolderExists(s_reserv_dir) Then FSO.DeleteFolder s_reserv_dir, True
    FSO.CopyFolder s_sourse_dir, s_reserv_dir, True
End Sub
Пишет файл не найден, не пойму где ошибка???
Изменено: mazersw - 29.10.2020 16:08:01
 
Цитата
mazersw написал:
не пойму где ошибка?
как всегда там, где накосячили:
s_sourse_dir = ActiveWorkbook.Path & "\Проект.txt"
это что? правильно, путь к файлу. А почему тогда проверяете на наличие папку?
Цитата
mazersw написал:
If Not FSO.FolderExists(s_sourse_dir) Then
да, забыл. Далее тот же косяк(а то вдруг не поймете). Копировать надо файлы, а копируете почему-то папку:
FSO.CopyFolder
Изменено: Дмитрий(The_Prist) Щербаков - 29.10.2020 16:15:32
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков Копировать надо файлы, а копируете почему-то папку:FSO.CopyFolder
СПС понял, переделал на файлы!
Изменено: vikttur - 25.08.2021 15:02:37
 
Цитата
JayBhagavan,а как прописать, чтобы все содержимое из папок 1,2,3,4 вырезалось и вставлялось в другие папки 11,22,33,44?
 
Создайте отдельную тему
Страницы: 1
Наверх