Nota del Editor: Código similar al ejemplo enviado por Moby (Guatemala) y publicado en: Crear un Zip usando los recursos estandard de Windows
***************************************************************
* COMPRIMIRENZIP.PRG
* Se encarga de comprimir en un archivo zip varias extensiones de Archivos
* utilizando el Shell de Windows - probado en XP
* FECHA : 19 MARZO 2008
* HECHO POR : ROTEROL (Rubén V. Otero L.)
* La Coruña, España
****************************************************************
LOCAL lcExtension, lcZip && Variables locales tipo Caracter
LOCAL lnArchivos, lnContArray, lnContArrayDef && Variables locales tipo Numérico
LOCAL loZip, loShell, loFolder && Variables locales tipo Objeto
LOCAL ARRAY laArchivos[1,1], laArcDef[1], laExtensiones[6] && Variables locales tipo Array
*!* Verifico todos los ficheros a comprimir y los guardo en un array único laArcDef
*!* No puedo hacer una sola instrucción adir con todas las extensiones de archivos, con lo cual,
*!* ejecuto tantos adir como sea necesario para almacenar los
*!* *.dbc, *.dct, *.dcx, *.dbf, *.fpt y *.cdx
laExtensiones[1] = "*.dbc"
laExtensiones[2] = "*.dcx"
laExtensiones[3] = "*.dct"
laExtensiones[4] = "*.dbf"
laExtensiones[5] = "*.fpt"
laExtensiones[6] = "*.cdx"
FOR EACH lcExtension IN laExtensiones
lnArchivos = ADIR(laArchivos,lcExtension)
*!* Dependiendo si es la primera vez que paso por el For Each, declaro el array laArcDef con el
*!* número de Archivos resultantes del Adir, Si no es la primera vez que paso por el For Each,
*!* incremento el número de elementos de laArcDef en la longitud que tiene actualmente
*!* mas el número de archivos resultantes del adir
IF lcExtension=laExtensiones[1]
lnContArrayDef = 0
DECLARE laArcDef[lnArchivos]
ELSE
lnContArrayDef = ALEN(laArcDef)
DECLARE laArcDef[ALEN(laArcDef)+lnArchivos]
ENDIF
FOR lnContArray = 1 TO lnArchivos
lnContArrayDef = lnContArrayDef + 1
laArcDef[lnContArrayDef] = ADDBS(FULLPATH(CURDIR()))+laArchivos[lnContArray,1]
NEXT
NEXT
lcZip = ADDBS(FULLPATH(CURDIR()))+'ArchivoComprimido.zip'
IF FILE(lcZip) && Borro Zip si existe
ERASE lcZip
ENDIF
*!* Creo Fichero Encabezado de zip
STRTOFILE(CHR(0x50)+CHR(0x4B)+CHR(0x05)+CHR(0x06)+REPLICATE(CHR(0),18),lcZip)
oShell = CREATEOBJECT("Shell.Application")
IF TYPE('oShell')='O'
*!* Según Investigué, Microsoft recomienda crear el Objeto oFolder y trabajar con ese objeto
*!* para hacer la instrucción copyHere intenté hacerlo directamente
*!* -oShell.NameSpace("&lcZip").copyHere(laArcDef[lnContArray])-, pero recibía contínuos errores de
*!* fallo de aplicación VFP. asimismo, tuve que crear el objeto oFolder con la macrosubstitución
*!* -oShell.NameSpace("&lcZip")- por que tambien, depurando el programa, detecté que no se
*!* creaba el objeto oFolder colocando la instrucción -oShell.NameSpace("&lcZip")- directamente
oFolder = oShell.NameSpace("&lcZip")
IF TYPE('oFolder')='O'
FOR lnContArray = 1 TO lnContArrayDef && ALEN(laArcDef)
WAIT 'Procesando Archivo '+LOWER(laArcDef[lnContArray])+', '+;
ALLTRIM(STR(lnContArray*100/lncontArrayDef))+'%' WINDOW NOWAIT
oFolder.CopyHere(laArcDef[lnContArray])
*!* Me veo obligado tambien a colocarle un inkey por que si no se pone y por ejemplo
*!* tenemos 48 archivos para comprimir (como es mi caso), el proceso lo efectúa muy rapido,
*!* y aún cuando sale del for...next, se crean tantos shell de Fox
*!* como archivos haya, con el dialogbox de "Comprimiendo..."
INKEY(0.5)
NEXT
WAIT CLEAR
oFolder = .F.
ELSE
MESSAGEBOX('No pudo crearse el Objeto oFolder',16)
ENDIF
oShell = .F.
ELSE
MESSAGEBOX('No pudo crearse el Objeto Shell',16)
ENDIF
Rubén V. Otero L.
Copié el código y lo ejecuté
ResponderBorrarFuncionó de maravilla
Gracias por contribución tan valiosa