Всем привет и с наступающим НГ! Есть файл, в котором в определенном столбце гиперссылки на документы сделаны. Файл большой и документов тысячи. Файлы на которые сделаны гиперссылки разные (архивы, ворды, сканы ) и размещены в разных папках. Мне для отчета требуется предоставлять документы за определенный период и по типу документа. Отфильтровать это без проблем, а вот каким маркосом сканы, ворды, архивы можно в одну папку (по нужному мне пути) не представляю. PS- папок в реальности больше и иногда в папке есть другие папки. Единственно - файл экслевский сохранен в папке, в которой лежат папки со всеми документами.
Всем привет и с наступающим НГ! Есть файл, в котором в определенном столбце гиперссылки на документы сделаны. Файл большой и документов тысячи. Файлы на которые сделаны гиперссылки разные (архивы, ворды, сканы ) и размещены в разных папках. Мне для отчета требуется предоставлять документы за определенный период и по типу документа. Отфильтровать это без проблем, а вот каким маркосом сканы, ворды, архивы можно в одну папку (по нужному мне пути) не представляю. PS- папок в реальности больше и иногда в папке есть другие папки. Единственно - файл экслевский сохранен в папке, в которой лежат папки со всеми документами.ovechkin1973
Объект FileSystemObject CopyFile Синтаксис: CopyFile(<Source>,<Destination>,<Overwrite>) Назначение: Копирует один или несколько файлов. Параметры: <Source> - строка, путь к источнику копирования (что копировать). В последнем компоненте параметра можно использовать групповые символы "*" и "?". <Destination> - строка, путь назначения (куда копировать). <Overwrite> - необязательный, булево (число). Перезаписывать существующие файлы, или нет. По умолчанию - True (перезаписывать). Если файл, который нужно перезаписать, имеет атрибут read-only, возникнет ошибка (независимо от установки этого параметра). Пример: Set FSO = CreateObject("Scripting.FileSystemObject") FSO.CopyFile "C:\*.bat", "A:\", 0
Добрый день.
Цитата
Объект FileSystemObject CopyFile Синтаксис: CopyFile(<Source>,<Destination>,<Overwrite>) Назначение: Копирует один или несколько файлов. Параметры: <Source> - строка, путь к источнику копирования (что копировать). В последнем компоненте параметра можно использовать групповые символы "*" и "?". <Destination> - строка, путь назначения (куда копировать). <Overwrite> - необязательный, булево (число). Перезаписывать существующие файлы, или нет. По умолчанию - True (перезаписывать). Если файл, который нужно перезаписать, имеет атрибут read-only, возникнет ошибка (независимо от установки этого параметра). Пример: Set FSO = CreateObject("Scripting.FileSystemObject") FSO.CopyFile "C:\*.bat", "A:\", 0
sboy, спасибо.. Лично мне это не поможет. Мой уровень - это скопировать и что то через цикл в другом месте поискать. Но завтра попробую коллег озадачить, показав ваш ответ. Обычно, если им идею дать - то код от них нужный получаю.
sboy, спасибо.. Лично мне это не поможет. Мой уровень - это скопировать и что то через цикл в другом месте поискать. Но завтра попробую коллег озадачить, показав ваш ответ. Обычно, если им идею дать - то код от них нужный получаю.ovechkin1973
Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
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]
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]
Код
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
Подумать-то можно... Только сдаётся мне, что FSO — это проводник, который тоже не особо любит копировать открытые файлы. Но это не точно, не проверял, сужу по описанию объекта.
Подумать-то можно... Только сдаётся мне, что FSO — это проводник, который тоже не особо любит копировать открытые файлы. Но это не точно, не проверял, сужу по описанию объекта.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
sboy, StoTisteg, УВАЖАЕМЫЕ! Благодарю за участие... но я в ваших ответах абсолютно не разбираюсь... После переделки кода макрос копирует в папку документы, но как оказалось тоже не все.. Примерно половину.. Что в предложенном коде нужно поменять?
sboy, StoTisteg, УВАЖАЕМЫЕ! Благодарю за участие... но я в ваших ответах абсолютно не разбираюсь... После переделки кода макрос копирует в папку документы, но как оказалось тоже не все.. Примерно половину.. Что в предложенном коде нужно поменять?ovechkin1973
Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
Люди! Прошу прощения! Проблема оказалась не в коде доработанном, а в том, что на сетевом диске, где файл и сканы хранятся- закончилось место... после изменения пути для сохранения отчета все стало ОК
Люди! Прошу прощения! Проблема оказалась не в коде доработанном, а в том, что на сетевом диске, где файл и сканы хранятся- закончилось место... после изменения пути для сохранения отчета все стало ОКovechkin1973
Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
Добрый день! У меня была подобная задача, делал вставку макроса впервые. Всё сработало с таким кодом. с остальными создавало только пустую папку...
[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]
Добрый день! У меня была подобная задача, делал вставку макроса впервые. Всё сработало с таким кодом. с остальными создавало только пустую папку...
[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
ovechkin1973, Здравствуйте! Вставил макрос. Создал пустую папку. я её удалил. повторно запустил макрос. и теперь не создает вообще ничего. With ActiveSheet.UsedRange.Columns("K") копирует только из столбца К? если мне нужно чтобы макрос работал только на выделенном диапазоне?
ovechkin1973, Здравствуйте! Вставил макрос. Создал пустую папку. я её удалил. повторно запустил макрос. и теперь не создает вообще ничего. With ActiveSheet.UsedRange.Columns("K") копирует только из столбца К? если мне нужно чтобы макрос работал только на выделенном диапазоне?svetexpertsorokin
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
