Sub MoveFiles() Dim xFd As FileDialog Dim xTFile As String Dim xExtArr As Variant Dim xExt As Variant Dim xSPath As String Dim xDPath As String Dim xSFile As String Dim xCount As Long Set xFd = Application.FileDialog(msoFileDialogFolderPicker) xFd.Title = "Please Select Original Folder:" If xFd.Show = -1 Then xSPath = xFd.SelectedItems(1) Else Exit Sub End If If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\" xFd.Title = "Please Select Destination folder:" If xFd.Show = -1 Then xDPath = xFd.SelectedItems(1) Else Exit Sub End If If Right(xDPath, 1) <> "\" Then xDPath = xDPath + "\" xExtArr = Array("*.xlsm*", "*.Docx") For Each xExt In xExtArr xTFile = Dir(xSPath & xExt) Do While xTFile <> "" xSFile = xSPath & xTFile FileCopy xSFile, xDPath & xTFile Kill xSFile xTFile = Dir xCount = xCount + 1 Loop Next MsgBox "Total number of moved files is: " & xCount, vbInformation, "Move File(S)" End Sub
Как это устроено:
- Скопируйте и вставьте этот код как стандартный модуль.
- Запустить макрос.
- Он открывает проводник и предлагает выбрать оригинальную (исходную) папку.
- Выберите папку и нажмите ОК.
- Снова он предложит вам выбрать папку назначения.
- Нажмите Ok, скоро вы получите окно с сообщением, сколько файлов было скопировано.
Замечания:
- Эта строка является редактируемой
Array("*.xlsm*", "*.Docx")
, вы можете заменитьFile extensions
на другую, в соответствии с вашими потребностями.