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

Вход

Регистрация

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

 

= Мир MS Excel/выгрузка файлов в папку по гиперссылкам из Экслель - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » выгрузка файлов в папку по гиперссылкам из Экслель (Макросы/Sub)
выгрузка файлов в папку по гиперссылкам из Экслель
ovechkin1973 Дата: Среда, 26.12.2018, 13:35 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Всем привет и с наступающим НГ!
Есть файл, в котором в определенном столбце гиперссылки на документы сделаны. Файл большой и документов тысячи. Файлы на которые сделаны гиперссылки разные (архивы, ворды, сканы ) и размещены в разных папках. Мне для отчета требуется предоставлять документы за определенный период и по типу документа. Отфильтровать это без проблем, а вот каким маркосом сканы, ворды, архивы можно в одну папку (по нужному мне пути) не представляю.
PS- папок в реальности больше и иногда в папке есть другие папки. Единственно - файл экслевский сохранен в папке, в которой лежат папки со всеми документами.
К сообщению приложен файл: __.7z (29.5 Kb)


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеВсем привет и с наступающим НГ!
Есть файл, в котором в определенном столбце гиперссылки на документы сделаны. Файл большой и документов тысячи. Файлы на которые сделаны гиперссылки разные (архивы, ворды, сканы ) и размещены в разных папках. Мне для отчета требуется предоставлять документы за определенный период и по типу документа. Отфильтровать это без проблем, а вот каким маркосом сканы, ворды, архивы можно в одну папку (по нужному мне пути) не представляю.
PS- папок в реальности больше и иногда в папке есть другие папки. Единственно - файл экслевский сохранен в папке, в которой лежат папки со всеми документами.

Автор - ovechkin1973
Дата добавления - 26.12.2018 в 13:35
sboy Дата: Среда, 26.12.2018, 14:30 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Цитата
Объект FileSystemObject
CopyFile
Синтаксис:
CopyFile(<Source>,<Destination>,<Overwrite>)
Назначение:
Копирует один или несколько файлов.
Параметры:
<Source> - строка, путь к источнику копирования (что копировать). В последнем компоненте параметра можно использовать групповые символы "*" и "?".
<Destination> - строка, путь назначения (куда копировать).
<Overwrite> - необязательный, булево (число). Перезаписывать существующие файлы, или нет. По умолчанию - True (перезаписывать). Если файл, который нужно перезаписать, имеет атрибут read-only, возникнет ошибка (независимо от установки этого параметра).
Пример:
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile "C:\*.bat", "A:\", 0


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Цитата
Объект FileSystemObject
CopyFile
Синтаксис:
CopyFile(<Source>,<Destination>,<Overwrite>)
Назначение:
Копирует один или несколько файлов.
Параметры:
<Source> - строка, путь к источнику копирования (что копировать). В последнем компоненте параметра можно использовать групповые символы "*" и "?".
<Destination> - строка, путь назначения (куда копировать).
<Overwrite> - необязательный, булево (число). Перезаписывать существующие файлы, или нет. По умолчанию - True (перезаписывать). Если файл, который нужно перезаписать, имеет атрибут read-only, возникнет ошибка (независимо от установки этого параметра).
Пример:
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile "C:\*.bat", "A:\", 0

Автор - sboy
Дата добавления - 26.12.2018 в 14:30
ovechkin1973 Дата: Среда, 26.12.2018, 15:19 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
sboy, спасибо.. Лично мне это не поможет. Мой уровень - это скопировать и что то через цикл в другом месте поискать. Но завтра попробую коллег озадачить, показав ваш ответ. Обычно, если им идею дать - то код от них нужный получаю.


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщениеsboy, спасибо.. Лично мне это не поможет. Мой уровень - это скопировать и что то через цикл в другом месте поискать. Но завтра попробую коллег озадачить, показав ваш ответ. Обычно, если им идею дать - то код от них нужный получаю.

Автор - ovechkin1973
Дата добавления - 26.12.2018 в 15:19
krosav4ig Дата: Среда, 26.12.2018, 16:57 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
sboy, есть жеж FileCopy
[vba]
Код
Sub sdf()
    On Error Resume Next
    Dim cell As Range, sPath$, sNewPath$, sHref$
    sPath = ThisWorkbook.Path & "\"
    sNewPath = sPath & "Отчет" & Format(Now, "dd.MM.yyyy hh_mm\\")
    MkDir sNewPath
    With ActiveSheet.UsedRange.Columns("K")
        For Each cell In Intersect(.Cells, .Offset(1)).SpecialCells(2, 23).SpecialCells(12).Cells
            sHref = cell.Hyperlinks(1).Address
            FileCopy sPath & sHref, sNewPath & Mid(sHref, InStrRev(sHref, "\") + 1)
        Next
    End With
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеsboy, есть жеж FileCopy
[vba]
Код
Sub sdf()
    On Error Resume Next
    Dim cell As Range, sPath$, sNewPath$, sHref$
    sPath = ThisWorkbook.Path & "\"
    sNewPath = sPath & "Отчет" & Format(Now, "dd.MM.yyyy hh_mm\\")
    MkDir sNewPath
    With ActiveSheet.UsedRange.Columns("K")
        For Each cell In Intersect(.Cells, .Offset(1)).SpecialCells(2, 23).SpecialCells(12).Cells
            sHref = cell.Hyperlinks(1).Address
            FileCopy sPath & sHref, sNewPath & Mid(sHref, InStrRev(sHref, "\") + 1)
        Next
    End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 26.12.2018 в 16:57
sboy Дата: Среда, 26.12.2018, 17:20 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
есть жеж FileCopy

Меньше нравится, т.к. при открытом файле даст ошибку (или пропустит копирование с resume next).


Яндекс: 410016850021169
 
Ответить
Сообщение
есть жеж FileCopy

Меньше нравится, т.к. при открытом файле даст ошибку (или пропустит копирование с resume next).

Автор - sboy
Дата добавления - 26.12.2018 в 17:20
ovechkin1973 Дата: Среда, 26.12.2018, 17:25 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, благодарю! На выложенном для примера файле код работает, а вот на родном - нет. Папку с отчетом делает, но она пустая.


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщениеkrosav4ig, благодарю! На выложенном для примера файле код работает, а вот на родном - нет. Папку с отчетом делает, но она пустая.

Автор - ovechkin1973
Дата добавления - 26.12.2018 в 17:25
ovechkin1973 Дата: Четверг, 27.12.2018, 06:26 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Нашел "косяк" в своем файле. По непонятным мне причинам гиперссылки макросом в моем файле почему то некоторые проставились со "\" в имени пути, а не которые с "/". Знакомый эту проблему мне нашел и чуть код поправил.
[vba]
Код
Private Sub CommandButton1_Click() ' Выгрузка отчета со сканами
    On Error Resume Next
    Dim cell As Range, sPath$, sNewPath$, sHref$
    sPath = ThisWorkbook.path & "\" 'задаем путь сохранения
    sNewPath = sPath & "Отчет" & Format(Now, "dd.MM.yyyy hh_mm\\")
    MkDir sNewPath
    With ActiveSheet.UsedRange.Columns("K")
        For Each cell In Intersect(.Cells, .Offset(1)).SpecialCells(2, 23).SpecialCells(12).Cells
            sHref = cell.Hyperlinks(1).Address
            sHref = Replace(sHref, "/", "\") 'новая строка
            FileCopy sPath & sHref, sNewPath & Mid(sHref, InStrRev(sHref, "\") + 1)
        Next
    End With
End Sub
[/vba]


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеНашел "косяк" в своем файле. По непонятным мне причинам гиперссылки макросом в моем файле почему то некоторые проставились со "\" в имени пути, а не которые с "/". Знакомый эту проблему мне нашел и чуть код поправил.
[vba]
Код
Private Sub CommandButton1_Click() ' Выгрузка отчета со сканами
    On Error Resume Next
    Dim cell As Range, sPath$, sNewPath$, sHref$
    sPath = ThisWorkbook.path & "\" 'задаем путь сохранения
    sNewPath = sPath & "Отчет" & Format(Now, "dd.MM.yyyy hh_mm\\")
    MkDir sNewPath
    With ActiveSheet.UsedRange.Columns("K")
        For Each cell In Intersect(.Cells, .Offset(1)).SpecialCells(2, 23).SpecialCells(12).Cells
            sHref = cell.Hyperlinks(1).Address
            sHref = Replace(sHref, "/", "\") 'новая строка
            FileCopy sPath & sHref, sNewPath & Mid(sHref, InStrRev(sHref, "\") + 1)
        Next
    End With
End Sub
[/vba]

Автор - ovechkin1973
Дата добавления - 27.12.2018 в 06:26
StoTisteg Дата: Четверг, 27.12.2018, 11:40 | Сообщение № 8
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
ovechkin1973, чтобы такого избегать, существует Application.PathSeparator.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщениеovechkin1973, чтобы такого избегать, существует Application.PathSeparator.

Автор - StoTisteg
Дата добавления - 27.12.2018 в 11:40
StoTisteg Дата: Четверг, 27.12.2018, 11:45 | Сообщение № 9
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
при открытом файле даст ошибку
Ну а FSO, можно подумать, скопирует.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение
при открытом файле даст ошибку
Ну а FSO, можно подумать, скопирует.

Автор - StoTisteg
Дата добавления - 27.12.2018 в 11:45
sboy Дата: Четверг, 27.12.2018, 12:18 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Ну а FSO, можно подумать, скопирует.

можно подумать :)


Яндекс: 410016850021169
 
Ответить
Сообщение
Ну а FSO, можно подумать, скопирует.

можно подумать :)

Автор - sboy
Дата добавления - 27.12.2018 в 12:18
StoTisteg Дата: Четверг, 27.12.2018, 13:09 | Сообщение № 11
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Подумать-то можно... Только сдаётся мне, что FSO — это проводник, который тоже не особо любит копировать открытые файлы. Но это не точно, не проверял, сужу по описанию объекта.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеПодумать-то можно... Только сдаётся мне, что FSO — это проводник, который тоже не особо любит копировать открытые файлы. Но это не точно, не проверял, сужу по описанию объекта.

Автор - StoTisteg
Дата добавления - 27.12.2018 в 13:09
sboy Дата: Четверг, 27.12.2018, 14:33 | Сообщение № 12
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Но это не точно, не проверял

А я проверял :)


Яндекс: 410016850021169
 
Ответить
Сообщение
Но это не точно, не проверял

А я проверял :)

Автор - sboy
Дата добавления - 27.12.2018 в 14:33
ovechkin1973 Дата: Четверг, 27.12.2018, 15:19 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
sboy, StoTisteg, УВАЖАЕМЫЕ! Благодарю за участие... но я в ваших ответах абсолютно не разбираюсь... После переделки кода макрос копирует в папку документы, но как оказалось тоже не все.. Примерно половину.. Что в предложенном коде нужно поменять?


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщениеsboy, StoTisteg, УВАЖАЕМЫЕ! Благодарю за участие... но я в ваших ответах абсолютно не разбираюсь... После переделки кода макрос копирует в папку документы, но как оказалось тоже не все.. Примерно половину.. Что в предложенном коде нужно поменять?

Автор - ovechkin1973
Дата добавления - 27.12.2018 в 15:19
sboy Дата: Четверг, 27.12.2018, 17:08 | Сообщение № 14
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Примерно половину

а по ссылкам эти файлы (не скопировались которые) нормально открываются?


Яндекс: 410016850021169
 
Ответить
Сообщение
Примерно половину

а по ссылкам эти файлы (не скопировались которые) нормально открываются?

Автор - sboy
Дата добавления - 27.12.2018 в 17:08
ovechkin1973 Дата: Четверг, 27.12.2018, 17:58 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
а по ссылкам эти файлы (не скопировались которые) нормально открываются?

да.. открываются


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщение
а по ссылкам эти файлы (не скопировались которые) нормально открываются?

да.. открываются

Автор - ovechkin1973
Дата добавления - 27.12.2018 в 17:58
ovechkin1973 Дата: Суббота, 29.12.2018, 13:05 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Люди! Прошу прощения! Проблема оказалась не в коде доработанном, а в том, что на сетевом диске, где файл и сканы хранятся- закончилось место... после изменения пути для сохранения отчета все стало ОК


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеЛюди! Прошу прощения! Проблема оказалась не в коде доработанном, а в том, что на сетевом диске, где файл и сканы хранятся- закончилось место... после изменения пути для сохранения отчета все стало ОК

Автор - ovechkin1973
Дата добавления - 29.12.2018 в 13:05
892o5588431 Дата: Среда, 06.07.2022, 19:15 | Сообщение № 17
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!
У меня была подобная задача, делал вставку макроса впервые. Всё сработало с таким кодом. с остальными создавало только пустую папку...

[vba]
Код
Sub sdf()
On Error Resume Next
Dim cell As Range, sPath$, sNewPath$, sHref$
sPath = ThisWorkbook.path & "\" 'задаем путь сохранения
sNewPath = sPath & "Отчет" & Format(Now, "dd.MM.yyyy hh_mm\\")
MkDir sNewPath
With ActiveSheet.UsedRange.Columns("K")
For Each cell In Intersect(.Cells, .Offset(1)).SpecialCells(2, 23).SpecialCells(12).Cells
sHref = cell.Hyperlinks(1).Address
sHref = Replace(sHref, "/", "\") 'новая строка
FileCopy sPath & sHref, sNewPath & Mid(sHref, InStrRev(sHref, "\") + 1)
Next
End With
End Sub
[/vba]


Сообщение отредактировал Serge_007 - Четверг, 07.07.2022, 09:15
 
Ответить
СообщениеДобрый день!
У меня была подобная задача, делал вставку макроса впервые. Всё сработало с таким кодом. с остальными создавало только пустую папку...

[vba]
Код
Sub sdf()
On Error Resume Next
Dim cell As Range, sPath$, sNewPath$, sHref$
sPath = ThisWorkbook.path & "\" 'задаем путь сохранения
sNewPath = sPath & "Отчет" & Format(Now, "dd.MM.yyyy hh_mm\\")
MkDir sNewPath
With ActiveSheet.UsedRange.Columns("K")
For Each cell In Intersect(.Cells, .Offset(1)).SpecialCells(2, 23).SpecialCells(12).Cells
sHref = cell.Hyperlinks(1).Address
sHref = Replace(sHref, "/", "\") 'новая строка
FileCopy sPath & sHref, sNewPath & Mid(sHref, InStrRev(sHref, "\") + 1)
Next
End With
End Sub
[/vba]

Автор - 892o5588431
Дата добавления - 06.07.2022 в 19:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » выгрузка файлов в папку по гиперссылкам из Экслель (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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