O que é o fenômeno chamado BIG DATA?
Sim meus caros, existem relatórios repletos de dados pré-processados, contidos em cubos OLAP. os quais ficam enormes, e, enquanto espaço em disco tiver alguma importância, precisaremos compactá-los para distribuí-los.
Este primeiro código abaixo extrairá conteúdo de arquivos Zip. Note que o parâmetro "24" suprime qualquer janela de diálogo que possa existir encapsulada no arquivo compactado. O arquivo será automaticamente sobreposto.
Para maiores detalhes leia: http://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx
Sim meus caros, existem relatórios repletos de dados pré-processados, contidos em cubos OLAP. os quais ficam enormes, e, enquanto espaço em disco tiver alguma importância, precisaremos compactá-los para distribuí-los.
Este primeiro código abaixo extrairá conteúdo de arquivos Zip. Note que o parâmetro "24" suprime qualquer janela de diálogo que possa existir encapsulada no arquivo compactado. O arquivo será automaticamente sobreposto.
Para maiores detalhes leia: http://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx
Function UnZip (PathToUnzipFileTo As Variant, FileNameToUnzip As Variant)
Dim objOApp As Object
Dim varFileNameFolder As Variant
Let varFileNameFolder = PathToUnzipFileTo
Set objOApp = CreateObject("Shell.Application")
objOApp.Namespace(varFileNameFolder).CopyHere objOApp.Namespace(FileNameToUnzip).items, 24
End Function
Sempre que possível, é bom termos um código diferente para aplicarmos uma técnica semelhante. Então segue mais um:
Sempre que possível, é bom termos um código diferente para aplicarmos uma técnica semelhante. Então segue mais um:
Sub UnZip(strTargetPath As String, Fname As Variant)
Dim oApp As Object, FSOobj As Object
Dim FileNameFolder As Variant
If Right(strTargetPath, 1) <> Application.PathSeparator Then
Let strTargetPath = strTargetPath & Application.PathSeparator
End If
Let FileNameFolder = strTargetPath
'create destination folder if it does not exist
Set FSOobj = CreateObject("Scripting.FilesystemObject")
If FSOobj.FolderExists(FileNameFolder) = False Then
FSOobj.CreateFolder FileNameFolder
End If
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
Set oApp = Nothing
Set FSOobj = Nothing
Set FileNameFolder = Nothing
End Sub
Ahh, e claro, não há sentido em ensinar a descompactar e não ensinar a como compactar, não é mesmo? Divirtam-se!
Ahh, e claro, não há sentido em ensinar a descompactar e não ensinar a como compactar, não é mesmo? Divirtam-se!
Sub zip_activeworkbook()
Dim strDate As String, DefPath As String
Dim FileNameZip, FileNameXls
Dim oApp As Object
If ActiveWorkbook Is Nothing Then Exit Sub
Let DefPath = ActiveWorkbook.Path
If Len(DefPath) = 0 Then
msgbox "Plz Save activeworkbook before zipping" & Space(12), vbInformation, "zipping"
Exit Sub
End If
If Right(DefPath, 1) <> "\" Then
Let DefPath = DefPath & "\"
End If
'Create date/time string and the temporary xls and zip file name
Let strDate = Format(Now, " dd-mmm-yy h-mm-ss")
Let FileNameZip = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".zip"
Let FileNameXls = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".xls"
If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then
'Make copy of the activeworkbook
ActiveWorkbook.SaveCopyAs FileNameXls
'Create empty Zip File
newzip (FileNameZip)
'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHere FileNameXls
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
'Delete the temporary xls file
Kill FileNameXls
msgbox "completed zipped : " & vbNewLine & FileNameZip, vbInformation, "zipping"
Else
msgbox "FileNameZip or/and FileNameXls exist", vbInformation, "zipping"
End If
End Sub
Private Sub newzip(sPath)
'Create empty Zip File
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
Tags: VBA, Zip, compact, Compactar, zipping, unzip,
Tags: VBA, Zip, compact, Compactar, zipping, unzip,
