Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
bedvit
599 / 159 / 18
Регистрация: 20.05.2016
Сообщений: 625
Записей в блоге: 6
1

Хранение файлов и файловый менеджер в файле(листе) Excel, Бинарное хранение данных в CustomProperty листа Excel

31.10.2017, 10:39. Просмотров 965. Ответов 11
Метки нет (Все метки)

Всем привет!
Хочу поделится наработками, которые получились в процессе реализации своих задач.
Отдельная благодарность! Андрей VG, за любезно предоставленные алгоритмы, которые были несколько доработаны и дополнены для этих целей.

Хранение файлов и простенький файловый менеджер в файле(листе) Excel, Бинарное хранение данных в CustomProperty листа (Open FileName As Binary и Get, Put через байт-массив)

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

Функционал:
1.Загрузка любых файлов (в т.ч. архивов, которые можно распаковать автоматом при выгрузке)
2.Просмотр загруженных (имя, размер), при удалении, выгрузке.
3.Удаление
4.Выгрузка с параметрами (папка, файл, распаковка из zip (архиватор не нужен, средствами винды), открыть файл после выгрузки, перезаписать еще раз при распаковке)
Все эти параметры Optional, если их нет выполняется с параметрами по умолчанию (распаковка в пользовательский "TEMP")

Все исходники и пример прилагаю (с авто-распаковкой библиотеки из zip-архива и её запуска).
В загруженных файлах секретных данных и вирусов нет.

P.S.
На Планете.
Развитие в блоге.
2
Вложения
Тип файла: zip Loader.zip (84.8 Кб, 10 просмотров)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
31.10.2017, 10:39
Ответы с готовыми решениями:

Заставить кнопку на листе Excel не перемещаться при прокрутке листа
Извините, еще один ламерский вопрос - можно ли сделать так, чтобы кнопочка,...

Сохранение значений переменной в файле Excel, но не на листе
Где-то я просторах инета читал о возможности сохранения значения переменной в...

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

Защита листа Excel, чтобы все изменения в файле осуществлялись только с UserForm
Подскажите пожалуйста, как в коде прописать защитить лист, чтобы все изменения...

Установка автофильтра в листе Excel при выгрузке данных из Access
Здравствуйте. Делаю выгрузку данных из формы аксесса в excel. Вот код выгрузки:...

11
bedvit
599 / 159 / 18
Регистрация: 20.05.2016
Сообщений: 625
Записей в блоге: 6
05.05.2018, 13:11  [ТС] 2
21/11/2017 Обновление версии: Loader_02
1.Процедуры переписаны в функции, которые возвращают при успешном выполнении, количество загруженных, удаленных, выгруженных файлов.
2.Добавлена пакетная загрузка файлов (выгрузка и удаление всех файлов уже было в первой версии) с корректным счетчиком (скриншот прилагаю).
3.Добавлено описание к коду и аргументам функций.
4.Добавлен запуск файлов как "приложением по умолчанию" так и через Excel.
5.Добавлен обработчик ошибок, с выводом сообщений об ошибке.
6.Добавлен запрос/вопрос пользователю на перезапись выгружаемых и загружаемых файлов, если они уже есть.

22/03/2018 Обновление версии: Loader_03
1.Добавил стартовое меню (скриншот прилагаю).
2.Добавил поддержку командной строки (на примере расчета числа Пи - программа упакована моя, вирусов нет.).
3.Изменил порядок параметров для функций на более логичный.

22/04/2018 Обновление версии: Loader_04
1.Добавил команду "ОТКРЫТЬ" в стартовом меню с поддержкой командной строки (скриншот прилагаю). Zip-файлы, при этом, сначала распаковываются, потом запускается первый файл в распакованной папке (поэтому рекомендуется хранить по одному файлу в архивах).
2.Изменил переход по листам с символов "<", ">" на "-","+" - удобно использовать цифровой блок клавиатуры.
3.Добавил возврат в меню при неверно введенных данных.

Исходники
1
Миниатюры
Хранение файлов и файловый менеджер в файле(листе) Excel, Бинарное хранение данных в CustomProperty листа Excel   Хранение файлов и файловый менеджер в файле(листе) Excel, Бинарное хранение данных в CustomProperty листа Excel   Хранение файлов и файловый менеджер в файле(листе) Excel, Бинарное хранение данных в CustomProperty листа Excel  

fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
05.05.2018, 16:58 3
Не в обиду, к чему этот весь мануал, это позволяет запустить автомат, робота или заставить трейдер на нужные валюты ставки делать ?

и еще


Visual Basic
1
2
3
4
                If UnZipB Then ' распаковываем ли архив
                    pShell.Namespace("" & UnloadPathNew & "").CopyHere pShell.Namespace("" & archiveName & "").Items, 4 Or 16
                    fso.DeleteFile archiveName
                End If
знаете что при таком подходе надо кэш очищать, просто в одно прекрасное время эта операция будет вызывать ошибку


Моя версия, отрывок из еще более крупного проекта

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Public Sub ZipCashClear()
    'Очистка ZIP КЭША на случай если ZIP оставил следы
    Dim v, tmpfldr$
    On Error Resume Next
    tmpfldr = Environ("tmp")
    If Len(tmpfldr) = 0 Then tmpfldr = Environ("temp")
    tmpfldr = FSO.GetAbsolutePathName(tmpfldr)
    For Each v In FSO.GetFolder(tmpfldr).SubFolders
        If LCase(Right$(v, 4)) = ".zip" Then
            FSO.DeleteFolder v, 1
        End If
    Next
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Public Sub ZipUnpac()
    'Распаковка
    Dim v, w, i&, fldr$, tmp$, f2$
 
    For i = 0 To 1 'Определение папки импорта
        If FSO.FolderExists([z1]) Then
            Exit For
        ElseIf i = 0 Then Call Input_imp
        Else: Exit Sub
        End If
    Next: fldr = [z1]
    ChDir fldr
    
    On Error Resume Next
    ZipCashClear
   
    For Each v In FSO.GetFolder(fldr).Files
 
        If LCase(Right$(v.Path, 4)) = ".zip" Then
            'Распаковываем все архивы
            
            '4 - Не показывать окно с прогресс-баром.
            '8 - Дать копируемому файлу новое имя, если файл с таким именем уже существует.
            '16 - Отвечать автоматически "Yes to All" в любом отображаемом диалоге.
            '256 - Отображать окно с прогресс-баром, но не показывать имена файлов.
            '4096 - Производить операции только в локальной папке. Не производить операции рекурсивно в подпапках.
            '9182 - Не копировать связанные файлы (например, html-файлы с их папками) как группу. Копировать только указанные файлы.
 
            ShApp.Namespace((fldr)).CopyHere ShApp.Namespace((v.Path)).items, 4 Or 8 Or 16
        End If
    Next
 
End Sub
Добавлено через 5 минут
и обратите внимание на эту запись
Цитата Сообщение от fever brain Посмотреть сообщение
ShApp.Namespace((fldr)).
Догадайтесь зачем я делаю две скобки ?
1
bedvit
599 / 159 / 18
Регистрация: 20.05.2016
Сообщений: 625
Записей в блоге: 6
05.05.2018, 22:13  [ТС] 4
Цитата Сообщение от fever brain Посмотреть сообщение
Не в обиду, к чему этот весь мануал, это позволяет запустить автомат, робота или заставить трейдер на нужные валюты ставки делать ?
Не совсем понял вопрос. Этот инструмент позволяет хранить любые файлы в листе Excel и совершать с ними простые операции. Если этот функционал вам пригодится для запуска автомата, робота или трейдера, то пожалуйста, я буду только рад.
Цитата Сообщение от fever brain Посмотреть сообщение
при таком подходе надо кэш очищать, просто в одно прекрасное время эта операция будет вызывать ошибку
, привидите пример, как в моем коде, может возникнуть переполнение кеша? Вы же наверняка видели, после
Visual Basic
1
2
3
4
If UnZipB Then ' распаковываем ли архив
aShell.Namespace("" & UnloadPathNew & "").CopyHere aShell.Namespace("" & archiveName & "").Items, 4 Or 16
fso.DeleteFile archiveName
End If
в конце, после цикла
Visual Basic
1
Set aShell = Nothing
Цитата Сообщение от fever brain Посмотреть сообщение
Очистка ZIP КЭША на случай если ZIP оставил следы
- что за следы?
Цитата Сообщение от fever brain Посмотреть сообщение
Догадайтесь зачем я делаю две скобки ?
- не могу знать-с... нравится?
0
fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
06.05.2018, 07:08 5
Вот смотри, скину тебе проектик, в котором все аскетично с одной кнопкой

Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub ZIP_unpack()
    
    Dim zip$, Folder$
    
    Folder = ThisWorkbook.Path
    zip = Folder & "\2.zip"
    
    With CreateObject("Shell.Application")
        
        'Первый вариант с двойными скобками будет работать
        .Namespace((Folder)).CopyHere .Namespace((zip)).Items, 4 Or 16
        
        'Второй вариант не будет, если перед этой строкой будет -
        'стоять инструкция On Error Resume Next, то просто ничего не произойдет
        'И поэтому я эту строчку просто закоментировал
        
        'Это объясняестся принимаемыми параметрами, в двойных скобках аргумент преобразуется ровно в ту переменную
        'которую требует эта функция
        
        
'''''        .Namespace(Flder).CopyHere .Namespace(zip).Items, 4 Or 16
        
        
    End With
 
 
End Sub


Должны будут распаковаться в эту же папку два файлика
0
Вложения
Тип файла: rar TEST.rar (10.2 Кб, 7 просмотров)
fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
06.05.2018, 07:14 6
Теперь если повторно эту-же операцию запустить возникнет нечто:
0
Миниатюры
Хранение файлов и файловый менеджер в файле(листе) Excel, Бинарное хранение данных в CustomProperty листа Excel  
fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
06.05.2018, 07:21 7
Надеюсь, стало видно что в папке нет тех самых файлов которая требует эта функция
но я знаю где они есть, они находятся во временной папке TEMP

Добавлено через 2 минуты
системное выполнение распаковки ZIP оставляет следы именно там, и именно из за этого возникают ошибки копирования (при распаковке)
0
fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
06.05.2018, 07:41 8
теперь если использовать очистку кэша zip
Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Public Sub ZipCashClear()
    'Очистка ZIP КЭША на случай если ZIP оставил следы
    Dim v, tmpfldr$
    On Error Resume Next
    tmpfldr = Environ("tmp")
    If Len(tmpfldr) = 0 Then tmpfldr = Environ("temp")
    With CreateObject("scripting.filesystemobject")
        tmpfldr = .GetAbsolutePathName(tmpfldr)
        For Each v In .GetFolder(tmpfldr).SubFolders
            If LCase(Right$(v, 4)) = ".zip" Then
                .DeleteFolder v, 1
            End If
        Next
    End With
End Sub
 
Sub ZIP_unpack()
    
    Dim zip$, Folder
    
    Folder = ThisWorkbook.Path
    zip = Folder & "\2.zip"
    
    
    Call ZipCashClear
    
    With CreateObject("Shell.Application")
        
        'Первый вариант с двойными скобками будет работать
        .Namespace((Folder)).CopyHere .Namespace((zip)).Items, 4 Or 16
        
        'Второй вариант не будет, если перед этой строкой будет -
        'стоять инструкция On Error Resume Next, то просто ничего не произойдет
        'И поэтому я эту строчку просто закоментировал
        
        'Это объясняестся принимаемыми параметрами, в двойных скобках аргумент преобразуется ровно в ту переменную
        'которую требует эта функция
        
        
'''''        .Namespace(Flder).CopyHere .Namespace(zip).Items, 4 Or 16
        
        
    End With
 
 
End Sub


то если файлы действительно существуют в этой папке, только тогда может возникнуть этот диалог
0
Вложения
Тип файла: rar TEST-2.rar (11.1 Кб, 4 просмотров)
fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
06.05.2018, 07:48 9
если Windos в новых своих обновлениях и сделал чтото полезное, он не захочет заниматься этими маленькими проблемами
Не-специалистам это будет неинтересно, даже непонятно, но когда ктото захочет использовать распаковки
они будут долго мучиться с непонятными ошибками, которые в таких ситуациях возникают поэтому я поделился своими знаниями
0
bedvit
599 / 159 / 18
Регистрация: 20.05.2016
Сообщений: 625
Записей в блоге: 6
07.05.2018, 11:45  [ТС] 10
Цитата Сообщение от fever brain Посмотреть сообщение
я поделился своими знаниями
это всегда приветствуется. Благодарю.
Цитата Сообщение от fever brain Посмотреть сообщение
Теперь если повторно эту-же операцию запустить возникнет нечто:
Протестировал на двух системах: win7x64 Excel2016x64 и win7x64 Excel2010x32 - раз 20 щелкал по кнопке - полет нормальный, все два варианта отрабатывают штатно, без ошибок, архив пераспаковывался, файлы перезаписывались.
fever brain, у вас какая система?
0
fever brain
oh my god
1121 / 595 / 115
Регистрация: 05.01.2016
Сообщений: 1,834
Записей в блоге: 7
08.05.2018, 00:28 11
Цитата Сообщение от bedvit Посмотреть сообщение
win7x64
Ты где тестировал, в своей-же оболочке, да понятно что у тебя x64 вот возьми ось например XP x86
и увидь как это работает, вот мне к примеру отправляет некий пользователь ваш файл и жалуется что он не работает, почему да как... вот мы это и выясняем ))
0
bedvit
599 / 159 / 18
Регистрация: 20.05.2016
Сообщений: 625
Записей в блоге: 6
08.05.2018, 09:20  [ТС] 12
На ХР х86 что конкретно не работает? И да странно, что задают вопрос вам, а не автору.

Добавлено через 5 минут
Ты где тестировал, в своей-же оболочке,
как понять в своей? Я тестировал два ваших файла на двух ПК, а где я должен был тестировать? В вашей "оболочке"?)
0
08.05.2018, 09:20
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
08.05.2018, 09:20

Разработать форму для ввода данных в таблицу на рабочем листе Excel
Форма такая: Название фильма/Жанр/Год выпуска/Страна/Продолжительность в мин.

Экспорт данных с листа Excel в файл или БД
Я начал делать программу когда вожу данные она заполняет лист 1 и 2 ведомость...

Перенос данных с одного листа на другой в Excel
На первом листе есть данные. При активации следующих листов проверить наличие...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru