Доброе утро уважаемы форумчане! Хочу сделать макрос, который будет копировать файлы, которые начинаются с символов "01 "из папки где лежит книга с папку "C:\01"
Есть такой код, но как прикрутить его под мои нужды пока не понимаю:
Код
SubCopy_File()
DimsFileName AsString,sNewFileName AsString
sFileName="C:\WWW.xls" 'имя файла для копирования
sNewFileName="D:\WWW.xls" 'имя копируемого файла. Директория(в данном случае диск D) должна существовать
IfDir(sFileName,16)=""ThenMsgBox"Нет такого файла",vbCritical,"Ошибка":ExitSub
FileCopy sFileName,sNewFileName'копируем файл
MsgBox"Файл скопирован",vbInformation,"www.excel-vba.ru"
EndSub
Папка на диске уже создана. Спасибо большое всем откликнувшимся!
Как на счет SaveAs ? Определяем кол-во файлов в папке: Set fso = CreateObject("Scripting.FileSystemObject";) koli4failov = fso.getfolder(Putt).Files.Count ' где Putt - путь к папке + слэш
Делаем цикл от 1 до koli4failov Если название файла содержит 01 (if NameFile Like "01*.xls" ) Open File SaveAs "Путь сохранения"
Sub Get_All_File_from_Folder() Dim sFolder As String, sNewFolder As String, sFiles As String
Dim sFileName As String, sNewFileName As String
'диалог запроса выбора папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
sNewFolder = "C:\01\"
'отключаем обновление экрана, чтобы наши действия не мелькали
Application.ScreenUpdating = False
sFiles = Dir(sFolder & "01*.xls*")
Do While sFiles <> ""
sFileName = sFolder & sFiles
sNewFileName = sNewFolder & sFiles
FileCopy sFileName, sNewFileName 'копируем файл
sFiles = Dir
Loop
'возвращаем ранее отключенное обновление экрана
Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...