Comprimir varios archivos desde excel

Estimados:

Tengo este código, el cual mediante un ventana seleccionas los archivos que deseas comprimir, pero necesito que seleccione archivos fijos que yo le diré, por ejemplo e C:\1.txt y C:\2.txt , solo me falta cambiar en esta variables FileNames = Application.GetOpenFilename _ , ahi me da la opción de selcionar lloos archivos a cambio de dejarlo fijo.

dejo el codigo

Sub ComprimirArchivos()
Dim ShellApp As Object
Dim FileNameZip As Variant
Dim FileNames As Variant
Dim i As Long, FileCount As Long
' Obtener los nombres de los archivo
FileNames = Application.GetOpenFilename _
(FileFilter:="Todos los archivos. (*.*),*.*", _
FilterIndex:=1, _
Title:=" Seleccione los archivos para comprimir. ", _
MultiSelect:=True)
' Salir si se cancela el cuadro de diálogo
If Not IsArray(FileNames) Then Exit Sub
FileCount = UBound(FileNames)
FileNameZip = Application.DefaultFilePath & "\PruebaComprimir.zip"
' Crear archivo Zip vacío...
Open FileNameZip For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
Set ShellApp = CreateObject("Shell.Application")
' Copia los archivos a la carpeta comprimida
For i = LBound(FileNames) To UBound(FileNames)
ShellApp.Namespace(FileNameZip).CopyHere FileNames(i)
Next i
On Error Resume Next
Do Until ShellApp.Namespace(FileNameZip).items.Count = FileCount
Application.Wait (Now + TimeValue("0:00:01"))
Loop
If MsgBox(FileCount & " Los archivos se han comprimido en:" & _
vbNewLine & FileNameZip & vbNewLine & vbNewLine & _
" Quieres ver el archivo zip?", vbQuestion + vbYesNo) = vbYes Then _
Shell "Explorer.exe /e," & FileNameZip, vbNormalFocus
End Sub

Añade tu respuesta

Haz clic para o