warten bis WinZip wieder geschlossen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan!
Wenn du WinZip über "Shell" aufrufst, dann geht's z.B. so.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'Quelle -ActiveVB.de

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
  hObject As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal _
  dwDesiredAccess As Long, ByVal bInheritHandle As _
  Long, ByVal dwProcessId As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
  (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare Sub Sleep Lib "kernel32.dll" ( _
  ByVal dwMilliseconds As Long)

Const STILL_ACTIVE = &H103
Const PROCESS_ALL_ACCESS = &H1F0FFF

Dim TaskID&

Private Function IsActive() As Boolean
Dim Handle&, ExitCode&

Handle = OpenProcess(PROCESS_ALL_ACCESS, False, TaskID)
Call GetExitCodeProcess(Handle, ExitCode)
Call CloseHandle(Handle)

IsActive = IIf(ExitCode = STILL_ACTIVE, True, False)
End Function

Sub start()

TaskID = Shell("notepad.exe", vbNormalFocus)

Do While IsActive
  DoEvents
  Sleep 250
Loop

MsgBox "Anwendung Läuft nicht mehr!"

End Sub

Gruß Sepp

Sub Archiv_waehlen_click() Dim FSO, Ordnername Dim verzKU As String Dim datChanged As Variant Dim i As Integer Dim START_PATH As String Dim nItems As Collection Dim l As Long Dim nListCount As Long Dim aki As String Dim k As Integer Dim str As String Dim newMap As Object Dim objNewMap As Object Dim file As String Dim wks Dim name As String archiv = Application.GetOpenFilename If archiv = falsch Then GoTo abbrechen strWinZip = pathWinZip & " -e" verzKU = kuOrdner & "kumuliert" '**************************************** Überprüfung ob Ordner "kumuliert" im AKI Verzeichnis schon existiert IndName = 0 NeuesVerz = "" VName = Array(verzKU, VerzeichnisNeu) On Error GoTo mkd_Err '*************************** falls Verzeichnis schon existiert For IndName = 0 To UBound(VName) NeuesVerz = NeuesVerz & VName(IndName) & "\" MkDir NeuesVerz Next IndName mkd_Err: 'If Err = 75 Then Resume Next ordner = kuOrdner & "kumuliert\" verzTMP = kuOrdner & "temp" strpfad = verzTMP Shell strWinZip & " """ & archiv & """ " & strpfad '*************hier ruf ich deinen Code auf, Sepp start Unload UserForm1 userform2.Show abbrechen: End Sub

Hallo Stefan!
Ungetestet.

' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function CloseHandle Lib "kernel32" (ByVal _
  hObject As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" (ByVal _
  dwDesiredAccess As Long, ByVal bInheritHandle As _
  Long, ByVal dwProcessId As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
  (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Declare Sub Sleep Lib "kernel32.dll" ( _
  ByVal dwMilliseconds As Long)

Const STILL_ACTIVE = &H103
Const PROCESS_ALL_ACCESS = &H1F0FFF

Dim TaskID&

Private Function IsActive() As Boolean
Dim Handle&, ExitCode&

Handle = OpenProcess(PROCESS_ALL_ACCESS, False, TaskID)
Call GetExitCodeProcess(Handle, ExitCode)
Call CloseHandle(Handle)

IsActive = IIf(ExitCode = STILL_ACTIVE, True, False)
End Function

Sub Archiv_waehlen_click()

Dim FSO, Ordnername
Dim verzKU As String

'*********************************************************************************************************************
'*********************************************************************************************************************

Dim datChanged As Variant
Dim i As Integer
Dim START_PATH As String

Dim nItems As Collection
Dim l As Long
Dim nListCount As Long

Dim aki As String
Dim k As Integer
Dim str As String
Dim newMap As Object
Dim objNewMap As Object

Dim file As String

Dim wks
Dim name As String

'*********************************************************************************************************************
'*********************************************************************************************************************

archiv = Application.GetOpenFilename

If archiv = falsch Then GoTo abbrechen

strWinZip = pathWinZip & " -e"

verzKU = kuOrdner & "kumuliert"

'**************************************** Überprüfung ob Ordner "kumuliert" im AKI Verzeichnis schon existiert

IndName = 0
NeuesVerz = ""
VName = Array(verzKU, VerzeichnisNeu)
On Error GoTo mkd_Err '*************************** falls Verzeichnis schon existiert
For IndName = 0 To UBound(VName)
  NeuesVerz = NeuesVerz & VName(IndName) & "\"
  MkDir NeuesVerz
Next IndName
mkd_Err:
'If Err = 75 Then Resume Next

ordner = kuOrdner & "kumuliert\"

verzTMP = kuOrdner & "temp"

strpfad = verzTMP

TaskID = Shell(strWinZip & " """ & archiv & """ " & strpfad, vbMinimizedNoFocus)

Do While IsActive
  DoEvents
  Sleep 100
Loop

Unload UserForm1
userform2.Show

abbrechen:

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

warten bis WinZip wieder geschlossen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

warten bis WinZip wieder geschlossen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread