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

@bedvit · Регистрация: 20.05.2016

Студворк — интернет-сервис помощи студентам

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

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

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

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

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

P.S.
На Планете.
Развитие в блоге.

@bedvit · 05.05.2018, 13:11 **[ТС]**

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.Добавил возврат в меню при неверно введенных данных.

Исходники

@fever brain · 05.05.2018, 16:58

Не в обиду, к чему этот весь мануал, это позволяет запустить автомат, робота или заставить трейдер на нужные валюты ставки делать ?

и еще

Visual Basic

                If UnZipB Then ' распаковываем ли архив
                    pShell.Namespace("" & UnloadPathNew & "").CopyHere pShell.Namespace("" & archiveName & "").Items, 4 Or 16
                    fso.DeleteFile archiveName
                End If

знаете что при таком подходе надо кэш очищать, просто в одно прекрасное время эта операция будет вызывать ошибку

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

Visual Basic

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

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)).

Догадайтесь зачем я делаю две скобки ?

@bedvit · 05.05.2018, 22:13 **[ТС]**

Сообщение от fever brain

Не в обиду, к чему этот весь мануал, это позволяет запустить автомат, робота или заставить трейдер на нужные валюты ставки делать ?

Не совсем понял вопрос. Этот инструмент позволяет хранить любые файлы в листе Excel и совершать с ними простые операции. Если этот функционал вам пригодится для запуска автомата, робота или трейдера, то пожалуйста, я буду только рад.

Сообщение от fever brain

при таком подходе надо кэш очищать, просто в одно прекрасное время эта операция будет вызывать ошибку

, привидите пример, как в моем коде, может возникнуть переполнение кеша? Вы же наверняка видели, после

Visual Basic

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

Догадайтесь зачем я делаю две скобки ?

- не могу знать-с... нравится?

@fever brain · 06.05.2018, 07:08

Вот смотри, скину тебе проектик, в котором все аскетично с одной кнопкой

Кликните здесь для просмотра всего текста

Visual Basic

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

Должны будут распаковаться в эту же папку два файлика

@fever brain · 06.05.2018, 07:14

Теперь если повторно эту-же операцию запустить возникнет нечто:

@fever brain · 06.05.2018, 07:21

Надеюсь, стало видно что в папке нет тех самых файлов которая требует эта функция
но я знаю где они есть, они находятся во временной папке TEMP

Добавлено через 2 минуты
системное выполнение распаковки ZIP оставляет следы именно там, и именно из за этого возникают ошибки копирования (при распаковке)

@fever brain · 06.05.2018, 07:41

теперь если использовать очистку кэша zip

Кликните здесь для просмотра всего текста

Visual Basic

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

то если файлы действительно существуют в этой папке, только тогда может возникнуть этот диалог

@fever brain · 06.05.2018, 07:48

если Windos в новых своих обновлениях и сделал чтото полезное, он не захочет заниматься этими маленькими проблемами
Не-специалистам это будет неинтересно, даже непонятно, но когда ктото захочет использовать распаковки
они будут долго мучиться с непонятными ошибками, которые в таких ситуациях возникают поэтому я поделился своими знаниями

@bedvit · 07.05.2018, 11:45 **[ТС]**

Сообщение от fever brain

я поделился своими знаниями

это всегда приветствуется. Благодарю.

Сообщение от fever brain

Теперь если повторно эту-же операцию запустить возникнет нечто:

Протестировал на двух системах: win7x64 Excel2016x64 и win7x64 Excel2010x32 - раз 20 щелкал по кнопке - полет нормальный, все два варианта отрабатывают штатно, без ошибок, архив пераспаковывался, файлы перезаписывались.
fever brain, у вас какая система?

@fever brain · 08.05.2018, 00:28

Сообщение от bedvit

win7x64

Ты где тестировал, в своей-же оболочке, да понятно что у тебя x64 вот возьми ось например XP x86
и увидь как это работает, вот мне к примеру отправляет некий пользователь ваш файл и жалуется что он не работает, почему да как... вот мы это и выясняем ))

@bedvit · 08.05.2018, 09:20 **[ТС]**

На ХР х86 что конкретно не работает? И да странно, что задают вопрос вам, а не автору.

Добавлено через 5 минут

Ты где тестировал, в своей-же оболочке,

как понять в своей? Я тестировал два ваших файла на двух ПК, а где я должен был тестировать? В вашей "оболочке"?)

@bedvit 1100 / 235 / 21 Регистрация: 20.05.2016 Сообщений: 1,068 Записей в блоге: 19
	08.05.2018, 09:20 [ТС]	12
	На ХР х86 что конкретно не работает? И да странно, что задают вопрос вам, а не автору. Добавлено через 5 минут Ты где тестировал, в своей-же оболочке, как понять в своей? Я тестировал два ваших файла на двух ПК, а где я должен был тестировать? В вашей "оболочке"?) 0

@bedvit 1100 / 235 / 21 Регистрация: 20.05.2016 Сообщений: 1,068 Записей в блоге: 19
	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

@fever brain oh my god 1454 / 793 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	06.05.2018, 07:14	6
	Теперь если повторно эту-же операцию запустить возникнет нечто: Миниатюры 0

@fever brain oh my god 1454 / 793 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	06.05.2018, 07:21	7
	Надеюсь, стало видно что в папке нет тех самых файлов которая требует эта функция но я знаю где они есть, они находятся во временной папке TEMP Добавлено через 2 минуты системное выполнение распаковки ZIP оставляет следы именно там, и именно из за этого возникают ошибки копирования (при распаковке) 0

@fever brain oh my god 1454 / 793 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	06.05.2018, 07:48	9
	если Windos в новых своих обновлениях и сделал чтото полезное, он не захочет заниматься этими маленькими проблемами Не-специалистам это будет неинтересно, даже непонятно, но когда ктото захочет использовать распаковки они будут долго мучиться с непонятными ошибками, которые в таких ситуациях возникают поэтому я поделился своими знаниями 0

@bedvit 1100 / 235 / 21 Регистрация: 20.05.2016 Сообщений: 1,068 Записей в блоге: 19
	07.05.2018, 11:45 [ТС]	10
	Сообщение от fever brain я поделился своими знаниями это всегда приветствуется. Благодарю. Сообщение от fever brain Теперь если повторно эту-же операцию запустить возникнет нечто: Протестировал на двух системах: win7x64 Excel2016x64 и win7x64 Excel2010x32 - раз 20 щелкал по кнопке - полет нормальный, все два варианта отрабатывают штатно, без ошибок, архив пераспаковывался, файлы перезаписывались. fever brain, у вас какая система? 0

@fever brain oh my god 1454 / 793 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	08.05.2018, 00:28	11
	Сообщение от bedvit win7x64 Ты где тестировал, в своей-же оболочке, да понятно что у тебя x64 вот возьми ось например XP x86 и увидь как это работает, вот мне к примеру отправляет некий пользователь ваш файл и жалуется что он не работает, почему да как... вот мы это и выясняем )) 0