VBA. Сохранить файл ЭКСЕЛЬ с атрибутом "СЖАТЫЙ"
'Не могу закончить большой проект
'База сохраняется в файлах *.xls, затем, после обработки
'раскидавается по компам пользователей
'жрёт много трафика . Хочу программно сжать (уменьшается примерно в 5 раз)
'Необходимо сохранить файл Эксель с атрибутом "СЖАТЫЙ"
'в справке не нашёл (у меня беда с английским).
'Что неверно в коде или не хватает ?
Sub SaveFile()
ActiveWorkbook.SaveAs Filename:="C:\1\FILE.xls", _
FileFormat:=xlNormal, CreateBackup:=False
End Sub
'Заранее спасибо
Идём сюда: http://msdn.microsoft.com/en-us/library/aa365535(VS.85).aspx -- и видим, что функция SetFileAttributes нам в этом деле не поможет, переходим по ссылке http://msdn.microsoft.com/en-us/library/aa363216(VS.85).aspx на DeviceIoControl, пишем в программе соответствующий declare, идём на http://msdn.microsoft.com/en-us/library/aa364230(VS.85).aspx и ищем там нужный ControlCode.
Да, AFAIK, файл перед установкой атрибута "сжатый" надо будет закрыть.
ВРОДЕ ДА.
НО ТЫ МЕНЯ ОЗАДАЧИЛ ВОПРОСОМ.
ОН СЖАТ ФОРТОЧКОЙ И ПЕРЕДАЁТСЯ ФОРТОЧКОЙ. НАВЕРНОЕ И АТРИБУТЫ ФОРТОЧНЫЕ (виндовские).???
НЕ ДУМАЛ ОБ ЭТОМ И НЕ ПРОБОВАЛ.
для SHIZOO ......... ПОПРОБОВАЛ. ДА ! В 5 РАЗ МЕНЬШЕ.
для PLISTERONa: ПРИ ИСПОЛЬЗОВАНИИ "АПИ" ВЫХОДИТ СООБЩЕНИЕ " DEFINED USER - NOT DEFINED" - ЭТО ЧТО ??? В СПРАВКЕ НЕТ ПОДРОБНОСТЕЙ. КОДА ОШИБКИ ТОЖЕ НЕТ . (ЭТО ТИПА ПОЛЬЗОВАТЕЛЬСКИЙ ТИП - НЕ ТИП ??? :-))
Код в студию!
Кроме WinAPI для установки этого атрибута можно использовать и WMI. Пример:
Dim objWMI As Object, objCollection As Object, objItem As Object
Dim strFile As String, intResult As Integer
strFile = "C:\\Temp\\book.xls"
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objCollection = objWMI.ExecQuery("SELECT * FROM CIM_LogicalFile WHERE Name='" & strFile & "'")
If objCollection.Count > 0 Then
For Each objItem In objCollection
If objItem.Compressed Then
MsgBox "Файл уже сжат. Метод сжатия: " & UCase(objItem.CompressionMethod)
Else
intResult = objItem.Compress
If intResult > 0 Then
MsgBox "Ошибка при попытке сжатия файла. Код ошибки: " & intResult, vbCritical
Else
MsgBox "Файл теперь сжат."
End If
End If
Next
Set objItem = Nothing
Else
MsgBox "Файл не найден.", vbExclamation
End If
Set objCollection = Nothing
Set objWMI = Nothing
End Sub
Макрос рабочий. Какая именно ошибка у Вас возникает?
кода :
Set objWMI =
GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
теперь всё работает.
А где лучше брать ХЕЛП по WMI ?
В целом - это оператор подключения к WMI локального компьютера с помощью моникера.
[color=blue]winmgmts:[/color] - обязательный префикс.
[color=blue]impersonationLevel=impersonate[/color] - наиболее часто употребляемый уровень олицетворения клиента для протокола DCOM (в данном примере не имеет практической ценности; такая запись - это лишь моя привычка, т.к. мне чаще всего приходится работать не с локальным, а с удалённым компьютером).
[color=blue].[/color] - обозначение, используемое для краткости записи вместо имени локального компьютера.
[color=blue]root\cimv2[/color] - путь к нужному пространству имён WMI.
Полную информацию по WMI (как и всегда в случаях с продукцией от "MS") можно найти в MSDN.
Для начала же рекомендую заглянуть сюда:
http://www.script-coding.info/WMI.html
Если интересно, найдите в сети VBInstaller - он с исходником и там есть модуль для сжатия двоичных данных;)
Спомощью VB.NET (Спасибо Хабибуллину А.) подробно и БОЛЬШЕ =>> [COLOR="Blue"]http://kbyte.ru/articles/showarticle.aspx?id=42&lang=ru[/COLOR]
Вот что удалось нарыть за 4! дня неустанного поиска
Работаем с информацией о файле
В этом разделе нам понадобится класс File и методы GetAttributes, SetAttributes.
Для определения атрибутов файла используется метод GetAttributes, он имеет следующий синтаксис:
Function GetAttributes(ByVal path As String) As FileAttributes
Пример:
Dim FileInfo As System.IO.FileInfo
Dim File As System.IO.File
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
File.GetAttributes("MyFile.asp")
End Sub
Path – полный путь и имя + расширение файла
Метод SetAttributes создан для установки атрибутов, имеет схожий синтаксис как для GetAttributes:
Sub SetAttributes (ByVal path As String, ByVal FileAttributes As FileAttributes)
Path – полный путь и имя + расширение файла
FileAttributes – Константа атрибута файла
Пример #1:
[SIZE="2"][COLOR="DarkRed"]Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
’Таким образом, файлу MyFile.xls устанавливается атрибут сжатого (Compressed)
System.IO.File.SetAttributes("MyFile.xls", IO.FileAttributes.Compressed)
End Sub[/COLOR][/SIZE]
Пример #2:
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
‘Установили файлу атрибут архивный и сжатый.
System.IO.File.SetAttributes("Path", IO.FileAttributes.Archive + IO.FileAttributes.Compressed)
End Sub
FileInfo позволяет брать любую информацию о файле.
Пример:
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim FileName As String = "C:\YourFile.txt"
Dim FileInfo As New System.IO.FileInfo(FileName)
FullFileName = FileInfo.FullName ‘Узнали полное имя файла
‘Многие задают вопрос: «Как узнать существует файл в этом каталоге или нет? Как проверить существование файла?» Ответ ждёт вас ниже:
If FileInfo.Exists = True Then MsgBox("Файл существует") Else MsgBox("Файл не существует")
End Sub