Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Копирование файлов, если вначале имени файла есть "01 "
 
Доброе утро уважаемы форумчане!
Хочу сделать макрос, который будет копировать файлы, которые начинаются с символов "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
Папка на диске уже создана.
Спасибо большое всем откликнувшимся!
Изменено: Владислав - 16 Апр 2015 23:36:24
 
Пока удалось выкрутиться командой для батника:
copy "01 *.*" "C:\01"
 
Как на счет SaveAs ?
Определяем кол-во файлов в папке:
Set fso = CreateObject("Scripting.FileSystemObject";)
koli4failov = fso.getfolder(Putt).Files.Count
' где Putt - путь к папке + слэш    

Делаем цикл от 1 до koli4failov
Если название файла содержит 01 (if NameFile Like "01*.xls" )
Open File
SaveAs "Путь сохранения"
Изменено: Anton - 16 Апр 2015 23:36:05
 
Там же на сайте есть статья: Просмотреть все файлы в папке
Если совместить, то получится требуемое:
Код
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
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Anton, зачем открывать? Если уж FSO, то перебираем все файлы папки, проверяем имя, далее FSO.CopyFile
Страницы: 1
Читают тему (гостей: 1)