*.xls per VBA zippen

Manfred · 2006-06-23T08:48:34+00:00

Hallo, bei meinem Versuch eine *.xls Datei zu Zippen, komme ich nicht weiter. Kann mir dabei bitte jemand behilflich sein. Ich habe diesen VBA-Code hier gefunden, er ist aber bei mir nicht lauffähig. 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 Ich möchte die Datei namens: C:\Programme\Gemeinsame Dateien\Urlaub.xls in C:\Programme\Gemeinsame Dateien\Urlaub.zip speichern und mir würde der VBA-Code reichen ohne das die einzelnen Dateien geöffnet werden. Gruss Manfred

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>

Forumthread: *.xls per VBA zippen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Excel-Datei mit VBA zippen: So funktioniert's

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)