7zip Shell funktioneirt nicht auf Server
05.10.2015 12:21:09
Hannes
habe ein etwas spezielles Problem, hoffe ihr könnt mir trotzdem helfen.
Wenn ich mein Makro auf meinen PC laufen lasse funktioniert es tadellos und kann mit Hilfe der Shell Funktion eine Datei mit 7zip entpacken.
Wenn ich das Makro allerdings auf einen Server laufen lasse dann entpackt er die Datei nicht. Ohne Fehlermeldung.
Woran kann das liegen? Wenn ich den Shell Befehle direkt in der cmd Kommandozeile eingebe dann klappt das entpacken, in Excel jedoch nicht.
Hier mein Codeaussicht.
Private Declare Function OpenProcess Lib "kernel32.dll" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE As Long = &HFFFFFFFF
___________________________________________________________________
Sub gz_entpacken()
'Dieses SUB entpackt eine Datei welche in GZDATEIPFAD
'hinterlegt ist und wartet solange bis die Datei fertig entpackt ist.
Dim fso As Object
Dim str7zipProgramm As String
Dim str7zipArchiv As String
Dim str7zipOrdner As String
Dim lngTaskID As Long
Dim lngProcID As Long
Dim lngExitCode As Long
'ausgewählte Datei entpacken mit 7-Zip
str7zipProgramm = "C:\Program Files\7-Zip\7z.exe" 'Pfad zur 7zip .exe
str7zipArchiv = GZDATEIPFAD 'Pfad zu entpackender Datei
str7zipOrdner = "D:\TEMP" 'Pfad Zielordner
Set fso = CreateObject("Scripting.FileSystemObject")
str7zipProgramm = fso.GetFile(str7zipProgramm).ShortPath
str7zipArchiv = fso.GetFile(str7zipArchiv).ShortPath
str7zipOrdner = fso.GetFolder(str7zipOrdner).ShortPath
'Shell für 7zip.exe verdeckt ausführen und solange warten bis 7zip.exe fertig ist mit entpacken
lngTaskID = Shell(str7zipProgramm & " x " & str7zipArchiv & " -o" & str7zipOrdner, _
vbMinimizedNoFocus)
lngProcID = OpenProcess(SYNCHRONIZE + PROCESS_QUERY_INFORMATION, 0&, lngTaskID)
Call WaitForSingleObject(lngProcID, INFINITE)
Call CloseHandle(lngProcID)
AppActivate Application.Caption, True
End Sub