*.xls per VBA zippen

Sub MappeSchliessen() Dim xlsName$, zipName$, Zip$ ActiveWorkbook.Save xlsName = ActiveWorkbook.FullName ActiveWorkbook.Close zipName = Left(xlsName, Len(xlsName) - 4) & xlsName.Zip Zip = c:\programme\winzip\winzip32.exe -a Shell Zip & zipName & xlsName End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Zippen2() Dim sDatei As String Dim sPfad As String sPfad = "D:\Userform\" ChDrive sPfad ChDir sPfad sDatei = Dir("*.xls") Do While sDatei <> "" Shell "c:\programme\winzip\winzip32.exe gepackt\" & Left(sDatei, Len(sDatei) - 4) & " " & sDatei sDatei = Dir Loop End Sub

Sub Zippen() 'alle in einem Verzeichnis befindlichen Dateien einzeln Zippen! Dim sDatei As String Dim sPfad As String sPfad = "C:\Test\" 'hier den Pfadnamen eingeben, bzw ändern! ChDrive sPfad ChDir sPfad sDatei = Dir("*.xls") Do While sDatei <> "" zipName = Left(sDatei, Len(sDatei) - 4) & ".zip" Shell "c:\programme\winzip\winzip32.exe -min -a " & sPfad & zipName & " " & sDatei sDatei = Dir Loop End Sub

Hallo Manfred,
zippe und entzippe Dateien. Habe jedoch Probleme mit dem Entzippen. Hast du da Erfolgreiches script? Meins sollte es tun, tut es aber nicht. Vielleicht kannst du den Fehler finden. Die Pfade in ein sheet in die genannten Zellen schreiben oder aber direkten Pfad eintragen in code. Das sheet muss offen sein beim zip-Vorgang. Dateien kann ich zippen, aber entzippen, da hapert es bzw. funktioniert mal gar nicht. Teste mal. Für Rückmeldung wäre ich dankbar. Ab Montag wieder im Büro. Gruß Horst
Zippen Modul 1:
Option Explicit
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const WAIT_TIMEOUT = &H102&
Declare <pre>
Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare <pre>
Function WaitForSingleObject Lib "Kernel32" (ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
<pre>
Sub Win32WaitTilFinished(ProgEXE As String)
Dim ProcessID As Long
Dim hProcess As Long
Dim RetVal As Long
ProcessID = Shell(ProgEXE, vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
Do
DoEvents
RetVal = WaitForSingleObject(hProcess, 50)
Loop Until RetVal <> WAIT_TIMEOUT
End Sub</pre>
Zippen Modul 2(zum Zippen dann):
<pre>
Sub PackedZip_01()
Dim sZipPath As String, sSourcePath As String, _
sTargetPath As String
sZipPath = Range("B1").Value
sSourcePath = Range("B4").Value
sTargetPath = Range("B5").Value
Call IfDir(sZipPath)
Call IfDir(sSourcePath)
' If Dir(sTargetPath) <> "" Then
' Kill sTargetPath
' End If
On Error GoTo ERRORHANDLER:
Win32WaitTilFinished _
sZipPath & " -a " & _
sTargetPath & " " & _
sSourcePath
MsgBox "Erfolgreich gezippt:" & vbLf & sTargetPath
Exit Sub
ERRORHANDLER:
MsgBox "F E H L E R ! Datei konnte nicht gepackt werden!"
End Sub</pre>
Zippen Modul 3 (zum entzippen):
' F E H L E R Dateien landen immer unter eigene Dateien ? oder funktioniert mal gar nicht ??
<pre>
Sub OpenZip_01()
Dim sZipPath As String, sSourcePath As String, sTargetPath As String
sZipPath = Range("B1").Value
sSourcePath = Range("B9").Value
' sTargetPath = "c:\Programm_QSB0e\"
sTargetPath = Range("B8").Value
Call IfDir(sZipPath)
Call IfDir(sSourcePath)
' If Dir(sTargetPath) <> "" Then
' Kill sTargetPath
' End If
' On Error GoTo ERRORHANDLER:
Call Win32WaitTilFinished(sZipPath & " -e " & sSourcePath)
' Workbooks.Open sTargetPath
Exit Sub
'ERRORHANDLER:
' Msgbox "Datei konnte nicht entpackt werden!"
End Sub</pre>

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread