Compactar com vba
Enviado: 10 Ago 2021 às 10:33
Prezados, bom dia.
Estou com um código que faz a compactação de arquivos selecionados, entretanto ele cria um zip para cada arquivo selecionado, gostaria de criar um único zip com todos os arquivos que selecionei. Conseguem dar uma força para fazer essa modificação?
Segue código:
Estou com um código que faz a compactação de arquivos selecionados, entretanto ele cria um zip para cada arquivo selecionado, gostaria de criar um único zip com todos os arquivos que selecionei. Conseguem dar uma força para fazer essa modificação?
Segue código:
Código: Selecionar todos
Private Sub btn_compactar_propostas_Click()
Dim sFileFullName As String
Dim sZipFileName As String
Dim sZipFileFullName As String
Dim varFileName
Dim pastaCotacao As String
pastaCotacao = "G:\Drives compartilhados\Gestão de Consumidores - Clientes\001 COTACAO DE ENERGIA\2021\Curto Prazo\08 2021\213 2021"
Set objFileDialogBox = Application.FileDialog(msoFileDialogFilePicker)
With objFileDialogBox
.ButtonName = gc_sFilePickButtonName
.AllowMultiSelect = True
.Filters.Add gc_sFilePickFileFilter, "*.*", 1
.Title = gc_sFilePickMsg
.InitialView = msoFileDialogViewDetails
.InitialFileName = pastaCotacao
.Show
If .SelectedItems.Count = 0 Then
MsgBox gc_sNoFilesSelectedMsg, vbInformation + vbOKOnly
Exit Sub
End If
For Each objfl In .SelectedItems
sFileFullName = objfl
sZipFileFullName = Mid(sFileFullName, 1, Len(sFileFullName) - 4) & ".zip"
varFileName = Split(sZipFileFullName, "\")
sZipFileName = varFileName(UBound(varFileName))
If Not oFso.FileExists(sZipFileName) Then
Set oFsoFolder = oFso.GetFolder(oFso.GetParentFolderName(objfl))
oFsoFolder.CreateTextFile sZipFileName
End If
CompactarArquivos sZipFileFullName, sFileFullName
Next objfl
End With
End Sub