AW: Makro soll auf Anwendung warten
30.07.2004 08:26:57
kdosi
Hallo Russi, ich weis nicht, ob es Dir hilft, aber der Code hat bei mir ohne Probleme functioniert! In dem Code habe ich aber vieles auskommentirt, also das Problem liegt irgendwo in dem auskommentiertem Code :-). Vesuch es ertsmals ohne den "On Error Resume Next" und "On Error GoTo 0" Statements, oder soltest Du die Err.Number Eigenschafft testen, ob keine Fehler aufgetreten sind, z.B :
On Error GoTo 0
Hier etwas tun ... "ABC"
If(Err.Number = 0) then alles OK else gabs Probleme bei ABC
Gruss kdosi, CZ
---------------------------------------------------------------------------------------
Option Explicit
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const WAIT_TIMEOUT = &H102&
Public Const PFAD As String = "C:\Program Files\EasyZip"
Public Const EXE_NAME As String = "EZIP.EXE"
Declare
Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare
Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Sub Zippen()
Dim Zip As String
Dim Dateiname As String
' Dim PFAD As String
Dim Zeile As Integer
' Dateiname = "Datenaktuell"
' Zeile = 3
' 'Do While ThisWorkbook.Sheets("Parameter").Cells(Zeile, 1).Value > ""
' PFAD = ThisWorkbook.Sheets("Parameter").Cells(Zeile, 1).Value
' ' ggf. alte ZIP-Datei löschen
' On Error Resume Next
' Kill (PFAD & Application.PathSeparator & Dateiname & ".zip")
' On Error GoTo 0
' ' ZIP-Datei generieren
' Zip = "c:\programme\winzip\winzip32.exe -min -a -r " _
' & """" & PFAD & Application.PathSeparator & Dateiname & ".zip"" " _
' & """" & PFAD & "\*.xls"""
Call Aufrufen_und_warten(VBA.IIf(VBA.Right(PFAD, 1) = "\", PFAD & EXE_NAME, PFAD & "\" & EXE_NAME))
VBA.MsgBox EXE_NAME & " beendet!"
' 'Shell Zip
' ' EXE aus ZIP generieren
' Zip = "c:\programme\winzip\wzsepe32.exe " & _
' """" & PFAD & Application.PathSeparator & Dateiname & ".zip"""
' Call Aufrufen_und_warten(Zip)
' 'Shell Zip
' Zeile = Zeile + 1
' 'Loop
End Sub
Sub Aufrufen_und_warten(ProgEXE As String)
Dim ProcessID As Long
Dim hProcess As Long
Dim RetVal As Long
ProcessID = Shell(ProgEXE)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
Do
DoEvents
RetVal = WaitForSingleObject(hProcess, 50)
Loop Until RetVal <> WAIT_TIMEOUT
End Sub