Vba переместить файл в другую папку
Обновлено: 21.11.2024
Для копирования файлов из одного места в другое папку или каталог с помощью Excel VBA требуется множество задач автоматизации. В этом примере мы увидим, как копировать файлы.
Копировать файлы из одного места в другое с помощью Excel VBA. Поможет вам при работе с файловыми операциями.
Решение(я):
Мы можем использовать метод CopyFile объекта FileSystemObject в Excel VBA. Сначала мы проверим, существует ли файл в этом месте. Затем мы можем скопировать файл, если он существует, в нужное место.
Вот пример кода VBA для копирования файла из одной папки в другую папку в Excel.
Инструкции:
- Открыть книгу Excel
- Нажмите клавиши ALT + F11, чтобы открыть редактор VBA.
- Вставьте новый модуль из меню "Вставка".
- Скопируйте приведенный выше код и вставьте его в окно кода.
- Укажите расположение необходимых файлов и папок
- Нажмите F5, чтобы выполнить код
- Теперь вы должны увидеть, что ваш файл скопирован в указанное место.
Примеры ситуаций и решений
Вот еще один пример, показывающий различные ситуации при копировании файла из одного места в другое.
Вариант 1: если файл не существует в исходном местоположении
Программа VBA для проверки существования файла в указанном месте.
Вариант 2: если файл существует в исходном местоположении
Код VBA должен скопировать исходный файл в папку назначения.
Вот результат выполнения макроса.
Вариант 3: если файл уже существует в папке назначения
Код VBA должен показывать пользователю сообщение о том, что файл уже доступен в папке назначения.
Вот пример кода для пояснения описанных выше ситуаций.
Пример файла:
Пожалуйста, загрузите следующий пример файла и найдите пример, чтобы объяснить вышеперечисленные ситуации, с которыми мы сталкиваемся при копировании файла из одного места в другую папку.
Analysistabs — копирование файлов из одного места в другое
Мощные и многоцелевые шаблоны для управления проектами. Теперь легко управляйте своими проектами, задачами, встречами, презентациями, командами, клиентами, заинтересованными сторонами и временем. На этой странице описаны все удивительные новые функции и возможности наших премиальных шаблонов.
Шаблоны расширенного планирования проекта
120+ шаблонов для управления проектами
Excel | PowerPoint | Слово
УЛУЧШЕННЫЙ ШАБЛОН УПРАВЛЕНИЯ РЕСУРСАМИ
50+ основных шаблонов управления проектами
Excel | PowerPoint | Слово
Шаблоны управления портфелем проектов
Excel | Шаблоны PowerPoint
50+ шаблонов управления проектами в Excel
Поделитесь этой историей, выберите платформу!
Об авторе: Валли
Разработчик Excel VBA, имеющий около 8 лет опыта использования Excel и VBA для автоматизации повседневных задач, создания отчетов и подготовки информационных панелей. Валли делится полезными примерами VBA и советами, которые помогают нам автоматизировать повседневные задачи.
Похожие записи
VBA ActiveSheet — объект активного листа Excel
Цветовой индекс Excel VBA
Копировать диапазон Excel VBA на другой лист с форматированием
Показать или скрыть|Выгрузить форму пользователя
35 комментариев
Код не работает.
Здравствуйте, Симон,
Не могли бы вы объяснить, где именно возникла проблема?
Спасибо, PNRao!
Мне подходит последний пример, однако мне бы хотелось, чтобы поиск выполнялся в исходной папке и во всех вложенных папках. Затем я хотел бы, чтобы он скопировал список файлов, этот список можно было бы найти в файле Excel, возможно ли это? Спасибо.
Эта функция доступна в нашей надстройке. Загрузите и используйте ее бесплатно.
Здравствуйте,
Спасибо за код, он очень полезен.
Я ищу аналогичный код для sbCopyingAFileReadFromSheet, где вместо одного файла есть список файлов. Я пытался использовать Do Loop, но продолжал получать сообщение «Объект не поддерживает это свойство или метод.
Пожалуйста, помогите :)
Это должно работать с циклами. Не могли бы вы опубликовать этот код здесь, чтобы я мог посмотреть и исправить, если есть какие-либо ошибки.
Спасибо за ваши усилия по облегчению жизни людей на земле!
Добрый день!
как скопировать папки с одного пути на другой в зависимости от списка в excel
Как сделать этот запуск ежедневным, если VBA распознает день и взаимодействует с датой в имени файла по мере ее изменения.
Здравствуйте! Большое спасибо, что поделились этим полезным кодом.
Посоветуйте другой сценарий, как будет изменен код, если я захочу переопределить файл назначения?
Здравствуйте, у меня возникла проблема с этим кодом. Я получаю сообщение об ошибке «Отказано в доступе». Я пытаюсь передать файл в своей рабочей среде, но у меня есть учетные данные для обычного доступа ко всем файлам (т.е. без VBA). Любая помощь приветствуется.
Я тоже столкнулся с той же проблемой. Пожалуйста, помогите…
Пожалуйста, проверьте, указали ли вы «\» в конце при назначении пути к исходному и целевому файлам
Sub CopyandRenameFile()
Dim src As String, dst As String, fl As String
Dim rfl As String
'Исходный каталог
src = Range("B3")
'Каталог назначения
dst = Range("b9″)
'Имя файла
fl = Range("B12″)
‘ —->ПЕРЕИМЕНОВАТЬ ФАЙЛ, И Я ХОЧУ СОСТАВИТЬ СПИСОК. Я ПЫТАЛСЯ ("D1:D10"), НО НЕ ПОЛУЧИЛОСЬ.
rfl = Диапазон("d1")
При ошибке возобновить следующий
FileCopy src & “\” & fl, dst & “\” & rfl
If Err.Number 0 Then
MsgBox “Ошибка копирования: ” & src & «\» & rfl
End If
При ошибке GoTo 0
End Sub
Я рад найти такой полезный сайт. Я хочу знать, как мне копировать больше файлов за один раз.?
Пожалуйста, мне нужна ваша помощь в моем проекте VBA. Я хочу скопировать данные из нескольких книг (ABCD) в основную книгу (E), но изо дня в день мои данные менялись. Я хочу, чтобы мои данные были в порядке WB A B C D, как мне может помочь VBA.
Привет, ребята,
Быстрый вопрос, я столкнулся с проблемой в этом коде,
Я изменил свой тип файла и путь к файлу в этом коде, и скрипт не может найти мой файл. Ниже приведены изменения
'Это ваше имя файла, которое вы хотите скопировать
sFile = "Sample.xlsx" (изменено на xlsx, так как мой файл - sample.xlsx)
'Изменить в соответствии с путем к исходной папке
sSFolder = "D:\Dec Work\1"
'Изменить в соответствии с путем к папке назначения
sDFolder = "D:\Dec Work\2"
Но он не может найти мой файл. Подскажите, пожалуйста, где я делаю ошибку?
Возможно, этот ответ слишком запоздал для вопроса, но я просто отвечу на любые другие ссылки в будущем,
Путь к папке должен заканчиваться на «\»,
например:- sSFolder = "D:\Dec Work\1\", а не sSFolder = "D:\Dec Work\1"
Это должно работать отлично
Можно ли указать путь к исходной папке, выбрав файл, и таким же образом позволить пользователю перейти в папку назначения, чтобы скопировать выбранный файл?
Спасибо за помощь.
Привет
Я надеюсь, что вы можете помочь.
У меня есть следующий код. Я пытаюсь переместить все наши ежедневные файлы из списка в Excel.
Столбец D имеет источник (D:\Жесткий диск\Жесткий диск Ли\Мои документы\WBD052U_PRINT01*.txt)
Столбец E имеет назначение (C:\Users\Lee\Documents\Work\ 01. WBD52U\)
Когда я запускаю макрос, я получаю следующую ошибку:
Ошибка времени выполнения 13. Несоответствие типов.
Если я просто сделаю 1 строку, то есть FromPath Range (D5: D5) ToPath Range (E5: E5), это работает отлично.
Как только я указываю больший диапазон, это не работает.
Спасибо, мне очень нужна помощь.
Sub Move_Daily_Files()
Dim FSO, MyFile
Dim FromPath As String
Dim ToPath As String
FromPath = ActiveSheet.Range("D5:D7")
ToPath = ActiveSheet.Range("E5:E7")
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile (FromPath), ToPath, True
MsgBox «Файл успешно скопирован в папку назначения», vbInformation, «Готово!»
FSO.CopyFile Source:=FromPath, Destination:=ToPath
End Sub
Здравствуйте,
Мне нужна помощь в отношении кода... где у меня есть список имен файлов (исключая их расширения) в столбце A2:A251. В данной папке есть файлы с такими именами. Каждый раз, когда я запускаю макрос, я хочу, чтобы произошло одно из действий.
а) либо имена файлов изменены с текущим именем файла + вчерашняя дата (дата последнего рабочего дня) и перемещены в определенную папку (папка не изменится)
ИЛИ
б) новая папка создается со вчерашней датой (последняя рабочая дата) каждый раз, когда запускается макрос, и перемещает эти файлы в папку
окончательно удалите файлы из исходной папки
Вышеприведенные примеры помогают справиться с одним файлом, как переместить 3 или более файлов с помощью этого?
Здравствуйте..
У меня такой вопрос:
Я хочу найти определенный файл в исходной папке, а затем скопировать этот файл и вставить его в папку назначения. Возможно ли это?
Если возможно, расскажите, как это сделать.
Здравствуйте! Спасибо, что поделились кодом.
Лично я нахожу это очень полезным, но когда я пытаюсь запустить его, я получаю сообщение «Указанный файл не найден». что мне делать, чтобы исправить ошибку.
Заранее спасибо.
Спасибо, спасибо, спасибо, очень полезно.
Привет
Спасибо, что поделились полезным кодом. Я хотел бы скопировать файлы из одной папки в другую с определенным расширением. Поскольку я избегаю копирования мусора, и я хотел бы копировать только файлы данных для резервного копирования.
Не могли бы вы помочь мне.
Заранее спасибо
Раджеш Баукар,
Я новичок в VBA.
Можно ли использовать подстановочный знак с sFile?
У меня отлично работает следующее:
format = Sheets("Blad1").Range("A4")
namn = ActiveCell.Offset(i, 0)
'Это имя вашего файла, который вы хотите скопировать
sFile = namn & format
Но я хотел бы иметь возможность перемещать файл, который начинается с (имя в ячейке), а затем независимо от суффикса будет скопирован..
Что-то вроде
format = Sheets("Blad1").Range("A4")
namn = ActiveCell.Offset(i, 0)
'Это имя вашего файла, который вы хотите скопировать
sFile = namn & "*" & format
Но это не работает. Есть идеи, как заставить это работать?
Он/она пропустил некоторые обратные косые черты.
Поместите обратную косую черту в конце исходного и целевого адресов.
Это должно исправить ситуацию.
Копировать файлы из одного места в другое с помощью Excel VBA. Поможет вам при работе с файловыми операциями.
этот код очень полезен для меня, большое спасибо. возможно ли, что во время выполнения этого кода появляется поле ввода, через которое мы можем переименовать новый созданный файл
Привет..
Я новичок, в соответствии с вашим примером файла я просто меняю путь и имя файла, но при запуске макроса, показывающего, что указанный файл не найден.
Можете ли вы предложить мне, где не так. для справки.
'В этом примере я копирую файл из папки "D:\AAA\BBB\TEST-1" в папку "D:\New folder\CCC\TEST-2"
Sub sbCopyingAFile()
‘Объявить переменные
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
'Это ваше имя файла, который вы хотите скопировать
sFile = "CHECK.dwg"
'Изменить в соответствии с путем к исходной папке
sSFolder = "D:\AAA\BBB\TEST-1"
«Изменить в соответствии с путем к папке назначения
sDFolder = «D:\Новая папка\CCC\TEST-2»
'Создать объект
Set FSO = CreateObject("Scripting.FileSystemObject")
'Проверка наличия файла в исходной папке
Если нет FSO.FileExists(sSFolder & sFile), то
MsgBox "Указанный файл не найден", vbInformation, "Не найден"
'Копирование, если тот же файл не находится в папке назначения
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
MsgBox «Указанный файл успешно скопирован», vbInformation, «Готово!»
Еще
MsgBox «Указанный файл уже существует в папке назначения», vbExclamation, «Файл уже существует»
Конец, если
У меня есть один вопрос, можем ли мы скопировать папку вместо файла, и можем ли мы переименовать его с текущей датой резервного копирования.
Заранее спасибо
Этот код очень полезен и экономит много времени.
Но в моей системе всегда отображается «Указанный файл не найден».
Несмотря на то, что файл существует.
Код работал очень хорошо,
Что делать, если я хочу разместить несколько файлов в нескольких папках соответственно
Здравствуйте, если бы я хотел, чтобы имя каталога называлось тем, что находится в определенной ячейке, например (A1=2017), и чтобы имя файла было создано для включения того же значения, но с фиксированным именем, как бы я это сделал?< /p>
Можно ли использовать этот код для копирования большого количества файлов из одной папки в другую на основе заданного списка Excel?
Excel FSO, также известный как объект файловой системы, имеет методы для перемещения, создания, изменения и удаления файлов и папок на компьютере. Используя пару его функций в этой статье, мы увидим, как копировать или перемещать файлы из одной папки в другую.
Теперь предположим, что у нас есть файл Excel со списком книг, которые нам нужно доставить одному из наших клиентов. Список имеет табличный формат (см. изображение выше, 2-й столбец). Нам нужно найти эти книги в папке, в которой уже есть коллекция многих книг, и проверить, доступна ли она или нет.
Это очень практичный сценарий, и в прошлом я сталкивался со многими такими требованиями. Если книги находятся в нашем инвентаре (в папке), то в столбце «Статус файла» будет отображаться статус «В наличии», и файлы будут скопированы или перемещены из исходной папки в папку назначения.
Копирование или перемещение файлов по разным папкам или каталогам играет немного другую роль. Помимо многих других методов, объект файловой системы предоставил нам 2 различных метода, таких как MoveFile и CopyFile .
Метод MoveFile
Синтаксис: объект.MoveFilesource, пункт назначения
Объект FSO. MoveFile навсегда переместит файлы из исходной папки в папку назначения. Его функция аналогична вырезанию и вставке объекта.
Метод CopyFile
Синтаксис: object.CopyFile, источник, место назначения, перезапись
Метод CopyFile копирует файлы из исходной папки в папку назначения. Исходная копия файла остается в исходной папке. Помимо источника и назначения, третий параметр является перезаписываемым логическим значением. Если установлено значение True, файлы в папке назначения будут перезаписаны, а если установлено значение false , файл в папке назначения останется без изменений.
Вы можете копировать или перемещать файлы любого типа в папке. В этом демонстрационном примере я буду искать только файлы .jpg, игнорируя файлы других типов.
Откройте файл Excel, создайте таблицу и добавьте в нее несколько строк. После создания таблицы нажмите Alt+F11, чтобы открыть модуль в Visual Basic IDE. Скопируйте и вставьте приведенный ниже код в модуль и сохраните файл как файл с поддержкой макросов. Запустите макрос, нажав F5, и посмотрите результат как в самом файле excel, так и в папке назначения.
Это полезные методы, и объект файловой системы поставляется с пакетом многих полезных методов. Однако перед использованием этих функций необходимо убедиться, что у папок есть необходимые разрешения. Так как многие из этих способов не дадут результата, если атрибуты папки установлены как доступные только для чтения. Вам также могут потребоваться разрешения от сервера, на котором вы выполняете эти функции.
Здравствуйте, давно пользуюсь этим кодом. Недавно я столкнулся с проблемой, когда код просит выбрать имена файлов, исходную папку и место назначения, а затем фактически не запускает и не копирует какие-либо файлы. По какой причине это может быть?
Возможно, вам следует снова скопировать и вставить код в новую книгу и проверить, существуют ли соответствующие имена файлов в списке ячеек рабочего листа.
Должно ли нажатие "F5" возвращать меня к последнему активному листу при запуске модуля VBA? Я использую Excel 2019 (почти эквивалентен Excel 365). Есть ли что-то еще, что я должен сделать, чтобы запустить его?
Отличный макрос.
Как это можно изменить для моего случая, как показано ниже. У меня нет опыта работы с VBA.
Исходные папки (3 — zmf, vek, num) и папки назначения (4 — jack, james, john, jane) имеют постоянные имена и пути.
Исходные папки ( 3)
\\192.168.xx.x\ma\zmf\ (файлы здесь — 123.wav, 456.wav и т.д.)
\\192.168.xx.x\ma\vek\ (файлы здесь – abc.wav и т.д.)
\\192.168.xx.x\ma\num\ (здесь файлы – ghi.wav и т.д.)
Папки назначения (4)
\\192.168 .xx.xx\ba\jack\
\\192.168.xx.xx\ba\james\
\\192.168.xx.xx\ba\john\
\\192.168.xx .xx\ba\jane\
В листе Excel в столбце AI есть список файлов (будет меняться ежедневно), которые необходимо КОПИРОВАТЬ (не перемещать) в папку в столбце B (папка в которые содержат файлы (zmf, vek, num), также необходимо скопировать.
Например, 123.wav необходимо скопировать в папку «jack», такую как \\192.168.xx.xx\ba\ jack\zmf\123.wav
abc.wav необходимо скопировать в папку «jane», например, \\192.168.xx.xx\ba\jane\vek\abc.wav
ghi.wav тоже надо скопировать в папку «джек», например \\192.168.xx.xx\ba\jack\num\ghi.wav
Столбец A Столбец B
Файлы в исходных папках Целевые папки (постоянные)
123.wav jack
456.wav james
789.wav john
abc. wav jane
def.wav джеймс
ghi.wav jack
Может ли кто-нибудь помочь с изменением этого макроса, пожалуйста?
У меня есть список из 10 000 файлов, которые необходимо переместить, но приведенный выше код останавливается после определения местоположения исходного файла. Пожалуйста, дайте мне знать, если мне нужно что-то изменить в коде.
Некоторые имена в списке содержат более 1 файла .jpg, и я хочу, чтобы ВСЕ эти файлы были скопированы. Может ли кто-нибудь изменить код соответствующим образом.
Что мне нужно изменить, если я всегда хочу искать файлы pdf и jpg, а затем копировать их только в одну папку назначения?
Кто-нибудь может помочь адаптировать код для поиска определенных файлов в папке и вложенных папках, а затем скопировать его в место назначения?
Чтобы скопировать файлы из одной папки, включая подпапки, в другую папку на основе списка на листе, примените следующий код.
Sub Copyfiles() 'Updateby Extendoffice Dim xRg As Range, xCell As Range Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog Dim xSPathStr As Variant, xDPathStr As Variant Dim xVal As String Dim fso As Object, folder1 As Object Set xRg = Application .InputBox("Пожалуйста, выберите имена файлов:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8) Если xRg не имеет значения, тогда выйдите из подмножества xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xSFileDlg.Title = " Выберите исходную папку:" Если xSFileDlg.Show <> -1, то выйдите из Sub xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\" Установите xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xDFileDlg.Title = "Выберите папка назначения:" Если xDFileDlg.Show <> -1, то выйдите из подпрограммы xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\" вызовите sCopyFiles(xRg, xSPathStr, xDPathStr) End Sub Sub sCopyFiles(xRg как диапазон, xSPathStr как вариант , xDPathStr как вариант) Dim xCell как диапазон Dim xVal как строка Dim xFolder как объект ct Dim fso As Object Dim xF As Object Dim xStr As String Dim xFS As Object Dim xI As Integer On Error Resume Next If Dir(xDPathStr, vbDirectory) = "" Then MkDir (xDPathStr) End If For xI = 1 To xRg.Count Установить xCell = xRg.Item(xI) xVal = xCell.Value Если TypeName(xVal) = "String" And Not (xVal = ""), то при ошибке GoTo E1 If Dir(xSPathStr & xVal, 16) <> Empty Then FileCopy xSPathStr & xVal, xDPathStr & xVal End If End If E1: Next xI On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") Set xFS = fso.GetFolder(xSPathStr) Для каждого xF In xFS.SubFolders xStr = xDPathStr & "\" & xF.Name Call sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\") If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _ И (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Then RmDir xStr End If Next End Sub
Можете ли вы помочь мне с этим? Я скопировал весь код, и все в порядке, но я хотел бы использовать только часть имени файла и не создавать папку при копировании файла из подпапки. Допустим, у меня есть папка AAA с файлом 123-321.pdf и подпапка BBB с файлом 123_111.pdf
В столбце Excel у меня есть только «123» без какого-либо расширения или «-» или «_», и я хочу скопировать все файлы, содержащие «123», из папки AAA в новую папку CCC.
Сейчас этот код будет копировать файлы только в том случае, если полное имя указано в столбце Excel, например "123-321.pdf", или создаст новую подпапку BBB в папке CCC, если вы ищете "123_111.pdf"
Жду вашего ответа, так как я даже не новичок в VBA, просто прохожу мимо :D
может ли кто-нибудь помочь адаптировать этот отличный код, чтобы диапазон файлов был фиксированным, например, все имена файлов в столбце A до пустой ячейки и предварительно установленный путь из, поскольку я всегда копирую из одного и того же источника
Sub Copymy1()
Затемнить список файлов как вариант
Затемнить i до длины
Затемнить filetocopy как строку
Затемнить источник копии как строку
Затемнить место назначения копии как строку
copysource = "C:\copyfrom\"
Copydestination = "C:copyto\"
filelist = ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion.Value
For i = 2 To UBound(filelist)
FName = Dir$(copysource & "*.*")
While FName <> ""
If UCase(FName) = UCase(filelist (i, 1)) Затем
Источник копирования FileCopy и FName, Место назначения копирования и FName
Конец, если
FName = Dir$()
Конец
Далее i
Извините, я только что увидел второй сценарий ниже.
У меня есть еще один (подходящий) запрос. Есть ли способ заставить скрипт выбрать отфильтрованный выбор в столбце? Вместо последовательных диапазонов ячеек... может ли быть способ выбрать только некоторые определенные строки после применения фильтра?
СПАСИБО
ОГРОМНОЕ спасибо за это. В моем случае это сработало идеально.
У меня есть один вопрос. можно ли изменить это, чтобы скопировать файлы во второй путь вместо их перемещения? Мне нужно будет применить эту функцию, но мне нужно, чтобы исходные файлы оставались в исходных папках.
Спасибо.
Здравствуйте, Сабин!
Вы хотите скопировать и вставить файлы из нескольких исходных папок, а не только из одной папки?
Если ссылка не существует, код разрывается,
какая строка должна быть, чтобы код выполнял переход через следующую ссылку без остановки
Что произойдет, если файл не существует в исходной папке?
код ломается
В коде должна быть строка для перехода к другой ссылке, если она не существует
Привет, я не эксперт в VBA, но мне нужен ваш модуль, и я сделал, как вы говорите, но ничего не скопировал из исходной папки в новую папку. и ошибка не отображается
Привет, Наср!
Чтобы переместить файлы из папки и подпапок на основе значений ячеек, примените приведенный ниже код VBA:
Попробуйте, надеюсь, это поможет вам!
Sub movefiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
Dim fso As Object, folder1 As Object
' On Error Resume Next
Set xRg = Application.InputBox("Выберите имена файлов:", " KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Если xRg не имеет значения, выйдите из Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Выберите исходную папку:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
xDFileDlg.Title = " Выберите папку назначения:"
Если xDFileDlg.Show <> -1, то выйдите из Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & " \"
Вызов sMoveFiles(xRg, xSPathStr, xDPathStr)
E и суб
Sub sMoveFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
Dim xCell As Range
Dim xVal As String
Dim xFolder As Object
Dim fso As Object
Dim xF As Object
Dim xStr As String
Dim xFS As Object
Dim xI As Integer
При ошибке возобновить следующий
If Dir(xDPathStr, vbDirectory ) = "" Then
MkDir (xDPathStr)
End If
For xI = 1 To xRg.Count
Set xCell = xRg.Item(xI)
xVal = xCell.Value
Если TypeName(xVal) = "String" And Not (xVal = "") Then
При ошибке GoTo E1
If Dir(xSPathStr & xVal, 16) <> Empty Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
Убить xSPathStr & xVal
Конец, если
Конец, если
E1:
Далее xI
При ошибке Возобновить Далее
Set fso = CreateObject("Scripting.FileSystemObject")
Set xFS = fso.GetFolder(xSPathStr)
Для каждого xF в xFS.SubFolders
xStr = xDPathStr & " \" & xF.Name ' Заменить(xF.ShortPath, xSPathStr, xDPathStr)
Вызов sMoveFiles (xRg, xF.ShortPath & "\", xStr & "\")
If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
And ( CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Then
RmDir xStr
End If
Next
End Sub
Я хочу скопировать или переместить файлы (.jpg, .jpg) любого формата из папки и ее подпапок. Приведенный выше скрипт копирует всю папку, содержащую соответствующий файл
Это прекрасно, спасибо,
но что, если я просто хочу копировать файлы, не перемещая их из подпапок только без необходимости создания подпапок в папке назначения,
то есть
исходной папке X: \\parent
внутри родителя находятся подпапки test1 (файл A), test2 (файл B) и test3 (файл C)
тогда папка назначения "Y:\\destination" содержит все 3 файла A, B , C без подпапок
Большое спасибо
Привет, Наср, ты понял, как это сделать? В данный момент я рассматриваю аналогичную потребность.
Копирование выбранных файлов из разных подпапок в одну папку
Привет, Майк
Я как бы сделал, НО косвенно, поэтому я изменил код, чтобы скопировать файлы, а не перемещать их во вложенную папку,
затем с файлом CMD переместил файл из вложенных папок в главную папку, затем удалите пустую подпапку
это то, что я сделал
Sub Copyfiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
Dim fso As Object, folder1 As Object
' On Error Resume Next
Set xRg = Application.InputBox("Выберите имена файлов:", " KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
Если xRg не имеет значения, выйдите из Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Выберите исходную папку:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
xDFileDlg.Title = " Выберите папку назначения:"
Если xDFileDlg.Show <> -1, то выйдите из Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & " \"
Вызов sCopyFiles(xRg, xSPathStr, xDPathStr)
E и суб
Sub sCopyFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
Dim xCell As Range
Dim xVal As String
Dim xFolder As Object
Dim fso As Object
Dim xF As Object
Dim xStr As String
Dim xFS As Object
Dim xI As Integer
При ошибке возобновить следующий
If Dir(xDPathStr, vbDirectory ) = "" Then
MkDir (xDPathStr)
End If
For xI = 1 To xRg.Count
Set xCell = xRg.Item(xI)
xVal = xCell.Value
Если TypeName(xVal) = "String" And Not (xVal = "") Then
При ошибке GoTo E1
If Dir(xSPathStr & xVal, 16) <> Empty Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
Конец, если
Конец, если
E1:
Далее xI
При ошибке Возобновить Далее
Установить fso = CreateObject("Scripting.FileSystemObject")
Set xFS = fso.GetFolder(xSPathStr)
Для каждого xF в xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Replace (xF.ShortPath, xSPathStr, xDPathStr)
Вызов sCopyFiles(xRg, xF.ShortPath & "\", xS tr & "\")
If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
And (CreateObject("scripting.FileSystemObject").GetFolder( xStr).SubFolders.Count = 0) Then
RmDir xStr
End If
Next
End Sub
затем скопируйте следующие строки в новый блокнот, затем сохраните его как cmd, назовите как угодно
для /r %%a IN (*.*) do (
move /y "%%a" "%cd%"
)
для /f "delims=" %%d in ('dir /s /b /ad ^| sort /r') do rd "%%d"
не забудьте скопировать код в 4 строки
надеюсь, это поможет
Того же результата можно добиться, используя только VBA, если добавить ' перед & "\" и xF.Name в строке ниже.
Это по-прежнему копирует из подпапок, но копирует в папку одного уровня.
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
становится
xStr = xDPathStr '& "\" & xF.Name ' Replace(xF .ShortPath, xSPathStr, xDPathStr)
не забудьте поместить файл cmd в ту же папку, в которую вы копируете файлы и подпапки, а затем дважды щелкните по нему
Перемещает один или несколько файлов из одного места в другое.
Синтаксис
объект.MoveFile источник, назначение
Синтаксис метода MoveFile состоит из следующих частей:
| Часть | Описание |
|---|---|
| object | Обязательный. Всегда имя объекта FileSystemObject. |
| source | Обязательно. Путь к файлу или файлам, которые нужно переместить. Строка аргумента source может содержать подстановочные знаки только в последнем компоненте пути. |
| destination | Обязательно. Путь, по которому файл или файлы должны быть перемещены. Аргумент destination не может содержать подстановочные знаки. |
Примечания
Если источник содержит подстановочные знаки или назначение заканчивается разделителем пути (****), предполагается, что назначение указывает существующий папка, в которую следует переместить соответствующие файлы. В противном случае предполагается, что destination является именем создаваемого целевого файла. В любом случае при перемещении отдельного файла могут произойти три вещи:
Если место назначения не существует, файл перемещается. Это обычный случай.
Если назначение является существующим файлом, возникает ошибка.
Если назначение является каталогом, возникает ошибка.
Ошибка также возникает, если подстановочный знак, используемый в исходном коде, не соответствует ни одному файлу. Метод MoveFile останавливается при первой обнаруженной ошибке. Не предпринимается никаких попыток отменить любые изменения, сделанные до возникновения ошибки.
Этот метод позволяет перемещать файлы между томами, только если поддерживается операционной системой.
См. также
Поддержка и обратная связь
Есть вопросы или отзывы об Office VBA или этой документации? См. раздел Поддержка и отзывы об Office VBA, чтобы узнать, как получить поддержку и оставить отзыв.
Читайте также: