Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Скопировать файлы из одной папки в другую по названию, дате - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать файлы из одной папки в другую по названию, дате (Макросы/Sub)
Скопировать файлы из одной папки в другую по названию, дате
ant6729 Дата: Среда, 09.01.2019, 15:55 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 519
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Всем привет, мало времени...прошу помочь
Хочу скопировать из одной папки в другую файлы с определенных форматом, определенной датой(сделано), определенным началом в названии файла

Вот вариант, но не полный.

[vba]
Код
Sub Copy_Files_Dates()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Fdate As Date
    Dim FileInFromFolder As Object
    
    Dim FileExt As String

    FromPath = "G:\1\3\"  '<< Change
    ToPath = "G:\1\145\"    '<< Change

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    If Right(ToPath, 1) <> "\" Then
        ToPath = ToPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    For Each FileInFromFolder In FSO.getfolder(FromPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        If Fdate >= DateSerial(2019, 1, 8) And Fdate <= DateSerial(2019, 1, 9) And FileInFromFolder = "OBC.TskMdt2*" Then
            FileInFromFolder.Copy ToPath
        End If
    Next FileInFromFolder
   

End Sub
[/vba]
 
Ответить
СообщениеВсем привет, мало времени...прошу помочь
Хочу скопировать из одной папки в другую файлы с определенных форматом, определенной датой(сделано), определенным началом в названии файла

Вот вариант, но не полный.

[vba]
Код
Sub Copy_Files_Dates()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Fdate As Date
    Dim FileInFromFolder As Object
    
    Dim FileExt As String

    FromPath = "G:\1\3\"  '<< Change
    ToPath = "G:\1\145\"    '<< Change

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    If Right(ToPath, 1) <> "\" Then
        ToPath = ToPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    For Each FileInFromFolder In FSO.getfolder(FromPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        If Fdate >= DateSerial(2019, 1, 8) And Fdate <= DateSerial(2019, 1, 9) And FileInFromFolder = "OBC.TskMdt2*" Then
            FileInFromFolder.Copy ToPath
        End If
    Next FileInFromFolder
   

End Sub
[/vba]

Автор - ant6729
Дата добавления - 09.01.2019 в 15:55
ant6729 Дата: Среда, 09.01.2019, 15:58 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 519
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Блин....

[vba]
Код
    If Fdate >= DateSerial(2019, 1, 8) And Fdate <= DateSerial(2019, 1, 9) And FileInFromFolder.Name Like "OBC.TskMdt2*" Then
            FileInFromFolder.Copy ToPath
[/vba]

Всем спасибо
 
Ответить
СообщениеБлин....

[vba]
Код
    If Fdate >= DateSerial(2019, 1, 8) And Fdate <= DateSerial(2019, 1, 9) And FileInFromFolder.Name Like "OBC.TskMdt2*" Then
            FileInFromFolder.Copy ToPath
[/vba]

Всем спасибо

Автор - ant6729
Дата добавления - 09.01.2019 в 15:58
_Boroda_ Дата: Среда, 09.01.2019, 16:08 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14484
Репутация: 5786 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Почитайте еще про Dir
https://docs.microsoft.com/ru-ru....unction
Тогда Вы сразу выявите все файлы по маске "OBC.TskMd" (не нужно будет проверять все), останется только проверить их на даты

Вот с примером
http://www.excelworld.ru/stuff/vba_function/files/dir/23-1-0-76

Если покороче, то вот
[vba]
Код
fs_ = Dir(Путь & Маска)
    Do While fs_ <> ""
        'условие
        fs_ = Dir
    Loop
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПочитайте еще про Dir
https://docs.microsoft.com/ru-ru....unction
Тогда Вы сразу выявите все файлы по маске "OBC.TskMd" (не нужно будет проверять все), останется только проверить их на даты

Вот с примером
http://www.excelworld.ru/stuff/vba_function/files/dir/23-1-0-76

Если покороче, то вот
[vba]
Код
fs_ = Dir(Путь & Маска)
    Do While fs_ <> ""
        'условие
        fs_ = Dir
    Loop
[/vba]

Автор - _Boroda_
Дата добавления - 09.01.2019 в 16:08
ant6729 Дата: Среда, 09.01.2019, 23:24 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 519
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Спасибо!
 
Ответить
СообщениеСпасибо!

Автор - ant6729
Дата добавления - 09.01.2019 в 23:24
ant6729 Дата: Понедельник, 14.01.2019, 15:10 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 519
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
В дополнение

А как прописать еще и временной интервал сюда

[vba]
Код
For Each FileInFromFolder In FSO.getfolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
If Fdate >= DateSerial(2019, 1, 8) And Fdate <= DateSerial(2019, 1, 9) And FileInFromFolder = "OBC.TskMdt2*" Then
FileInFromFolder.Copy ToPath
End If
Next FileInFromFolder
[/vba]

В курсе, что есть TimeSerial, но пока не могу внять, как его прикрутить


Сообщение отредактировал ant6729 - Понедельник, 14.01.2019, 15:10
 
Ответить
СообщениеВ дополнение

А как прописать еще и временной интервал сюда

[vba]
Код
For Each FileInFromFolder In FSO.getfolder(FromPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
If Fdate >= DateSerial(2019, 1, 8) And Fdate <= DateSerial(2019, 1, 9) And FileInFromFolder = "OBC.TskMdt2*" Then
FileInFromFolder.Copy ToPath
End If
Next FileInFromFolder
[/vba]

В курсе, что есть TimeSerial, но пока не могу внять, как его прикрутить

Автор - ant6729
Дата добавления - 14.01.2019 в 15:10
RAN Дата: Понедельник, 14.01.2019, 15:22 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4952
Репутация: 987 ±
Замечаний: 0% ±

2010
как его прикрутить

Шурупами. :)
А дата к дате добавляется путем сложения.


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
как его прикрутить

Шурупами. :)
А дата к дате добавляется путем сложения.

Автор - RAN
Дата добавления - 14.01.2019 в 15:22
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Скопировать файлы из одной папки в другую по названию, дате (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!