Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1764to1768
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Fehler CreatePipe in Excel 64bit

Fehler CreatePipe in Excel 64bit
08.06.2020 08:32:54
Jan-Hendrik
Hallo zusammen,
ich verwende seit einiger Zeit unter Excel 32bit den Code in der beigefügten Datei (https://www.herber.de/bbs/user/138120.xls) um Kommandozeilen-Befehle auszuführen und das Ergebnis weiter zu verarbeiten. Seit der Migration zu Office 2019 64bit bekomme ich beim Ausführen immer die Fehlermeldung "Unzulässiger Zugriff auf einen Speicherbereich". Bei anderen Funktionen hat das Hinzufügen der Ptr-Safe-Tags geholfen, hier leider nicht. Auslöser des Fehlers ist die CreatePipe-Funktion.
Der Ping-Befehl in der Sub test() ist nur ein Beispiel um das Problem zu zeigen, im "echten" Programm wird ein Kommandozeilen-Befehl für ein Messgerät aufgerufen.
Es wäre schön, wenn mir hier jemand erklären kann, was an dem Code noch geändert werden muss oder eine andere Möglichkeit kennt, um einen Kommandozeilen-Befehl aufzurufen mit
- verstecktem Fenster
- Möglichkeit zur Auswertung der Rückgabewerte (am besten ohne temporäre Datei)
- Verwendung eines Status-Balkens (in der beigefügten Datei auskommentiert)
Danke und viele Grüße
Jan-Hendrik

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

Betreff
Datum
Anwender
Anzeige
AW: VBA-Code
08.06.2020 08:54:21
Fennek
Hallo,
bei einem so komplexen Code ist es besser ihn zuerste zu zeigen, damit jeder potentielle Helfer weis, worauf er/sie sich einläßt.

Attribute VB_Name = "Modul1"
Option Explicit
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Declare PtrSafe Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal  _
lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal  _
dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare PtrSafe Function CreatePipe Lib "kernel32" (phReadPipe _
As LongPtr, phWritePipe As LongPtr, lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile _
As LongPtr, ByVal lpBuffer As String, ByVal _
nNumberOfBytesToRead As Long, lpNumberOfBytesRead As _
Long, ByVal lpOverlapped As Any) As Long
Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As _
String, lpProcessAttributes As Any, lpThreadAttributes _
As Any, ByVal bInheritHandles As Long, ByVal _
dwCreationFlags As Long, ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, _
lpProcessInformation As Any) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
hObject As LongPtr) As Long
Private Declare PtrSafe Function PeekNamedPipe Lib "kernel32" (ByVal _
hNamedPipe As LongPtr, lpBuffer As Any, ByVal nBufferSize _
As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As LongPtr
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Const STARTF_USESTDHANDLES = &H100&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESHOWWINDOW As Long = &H1&
Private Function ExecCmdOld(cmdline$, balken As Boolean) As String
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As LongPtr, hWritePipe As LongPtr
Dim L As Long, result As Long, bSuccess As Long
Dim Buffer As String
Dim k As Long
Dim retText As String
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
result = CreatePipe(hReadPipe, hWritePipe, sa, 0)
Dim strMessage As String
strMessage = Space$(512)
Dim lngStatus As Long
If result = 0 Then
lngStatus = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0,  _
strMessage, Len(strMessage), 0)
MsgBox strMessage
MsgBox "CreatePipe failed Error!"
Exit Function
End If
With start
.cb = Len(start)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
.hStdOutput = hWritePipe
.wShowWindow = vbHide ' *** von rkhb: Konsolenfenster nicht zeigen
End With
result = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If result  0 Then
'*** Anfang der Verbesserung Achim Neubauer***
Dim lPeekData As Long
k = 0
Do
Call PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, _
lPeekData, ByVal 0&)
If lPeekData > 0 Then
Buffer = Space$(lPeekData)
bSuccess = ReadFile(hReadPipe, Buffer, Len(Buffer), L, 0&)
If bSuccess = 1 Then
retText = retText & Left(Buffer, L)
Else
MsgBox "ReadFile failed!"
End If
Else
bSuccess = WaitForSingleObject(proc.hProcess, 0&)
If bSuccess = 0 Then
Exit Do
End If
End If
'If balken Then
'    If k = 100000 Then
'        k = 0
'    End If
'    k = k + 1
'    UserFormBalken.ProgressBar1 = k / 1000
'End If
DoEvents
Loop
'*** Ende der Verbesserung Achim Neubauer ***
Else
MsgBox "Error while starting process!"
End If
Call CloseHandle(proc.hProcess)
Call CloseHandle(proc.hThread)
Call CloseHandle(hReadPipe)
Call CloseHandle(hWritePipe)
ExecCmdOld = retText
End Function
Private Sub test()
MsgBox ExecCmdOld("ping.exe", False)
End Sub
mfg
Anzeige
AW: Fehler CreatePipe in Excel 64bit
08.06.2020 09:24:47
volti
Hallo Jan-Hendrik,
versuch es mal damit:
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Evtl. auch den Declare anpassen....
Declare PtrSafe Function CreatePipe Lib "kernel32" Alias "CreatePipe" ( _
phReadPipe As LongPtr, phWritePipe As LongPtr, lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long) As Long
viele Grüße
Karl-Heinz
AW: Fehler CreatePipe in Excel 64bit
08.06.2020 10:12:55
Jan-Hendrik
Hallo,
vielen Dank für die schnelle Antwort. Ich habe die Änderung lpSecurityDescriptor As LongPtr getestet (einmal mit Anpassung des Declare und einmal ohne. Es erscheint keine Fehlermeldung mehr, sondern das Konsolenfenster taucht kurz auf, Excel stürzt ab und startet sich neu. Der Absturz passiert bei diesem Abschnitt:
result = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

Anzeige
AW: Fehler CreatePipe in Excel 64bit
08.06.2020 10:39:40
volti
Hallo,
Du musst nicht nur die Declares anpassen, sondern auch alle Types und Handles.
Schau mal, ob ich alles erwischt habe:

Option Explicit
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Declare PtrSafe Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare PtrSafe Function CreatePipe Lib "kernel32" (phReadPipe _
As LongPtr, phWritePipe As LongPtr, lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
Private Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile _
As LongPtr, ByVal lpBuffer As String, ByVal _
nNumberOfBytesToRead As Long, lpNumberOfBytesRead As _
Long, ByVal lpOverlapped As Any) As Long
Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As _
String, lpProcessAttributes As Any, lpThreadAttributes _
As Any, ByVal bInheritHandles As Long, ByVal _
dwCreationFlags As Long, ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, _
lpProcessInformation As Any) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
hObject As LongPtr) As Long
Private Declare PtrSafe Function PeekNamedPipe Lib "kernel32" (ByVal _
hNamedPipe As LongPtr, lpBuffer As Any, ByVal nBufferSize _
As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, _
lpBytesLeftThisMessage As Long) As Long
Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As LongPtr, ByVal dwMilliseconds As Long) As Long
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As LongPtr
  bInheritHandle As Long
End Type
Private Type STARTUPINFO
  cb As Long
  lpReserved As String
  lpDesktop As String
  lpTitle As String
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As LongPtr
  hStdInput As LongPtr
  hStdOutput As LongPtr
  hStdError As LongPtr
End Type
Private Type PROCESS_INFORMATION
  hProcess As LongPtr
  hThread As LongPtr
  dwProcessId As Long
  dwThreadId As Long
End Type
Private Const STARTF_USESTDHANDLES = &H100&
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESHOWWINDOW As Long = &H1&
Private Function ExecCmdOld(cmdline$, balken As Boolean) As String
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim sa As SECURITY_ATTRIBUTES
    Dim hReadPipe As LongPtr, hWritePipe As LongPtr
    Dim L As Long, result As Long, bSuccess As Long
    Dim Buffer As String
    Dim k As Long
    Dim retText As String
    sa.nLength = Len(sa)
    sa.bInheritHandle = 1&
    sa.lpSecurityDescriptor = 0&
    result = CreatePipe(hReadPipe, hWritePipe, sa, 0)
     Dim strMessage As String
        strMessage = Space$(512)
         Dim lngStatus As Long
    If result = 0 Then
    lngStatus = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0, strMessage, Len(strMessage), 0)
            MsgBox strMessage
    MsgBox "CreatePipe failed Error!"
    Exit Function
    End If
    With start
    .cb = Len(start)
    .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    .hStdOutput = hWritePipe
    .wShowWindow = vbHide ' *** von rkhb: Konsolenfenster nicht zeigen
    End With
'ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES,
'lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long,
'lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
    result = CreateProcessA(0&, cmdline$, sa, sa, 1&, _
    NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
    If result <> 0 Then
    '*** Anfang der Verbesserung Achim Neubauer***
    Dim lPeekData As Long
    k = 0
    Do
    Call PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, _
    lPeekData, ByVal 0&)
    If lPeekData > 0 Then
    Buffer = Space$(lPeekData)
    bSuccess = ReadFile(hReadPipe, Buffer, Len(Buffer), L, 0&)
    If bSuccess = 1 Then
    retText = retText & Left(Buffer, L)
    Else
    MsgBox "ReadFile failed!"
    End If
    Else
    bSuccess = WaitForSingleObject(proc.hProcess, 0&)
    If bSuccess = 0 Then
    Exit Do
    End If
    End If
    'If balken Then
    '    If k = 100000 Then
    '        k = 0
    '    End If
    '    k = k + 1
    '    UserFormBalken.ProgressBar1 = k / 1000
    'End If
    DoEvents
    Loop
    '*** Ende der Verbesserung Achim Neubauer ***
    Else
    MsgBox "Error while starting process!"
    End If
    Call CloseHandle(proc.hProcess)
    Call CloseHandle(proc.hThread)
    Call CloseHandle(hReadPipe)
    Call CloseHandle(hWritePipe)
    ExecCmdOld = retText
    End Function
    Private Sub test()
    MsgBox ExecCmdOld("ping.exe", False)
    End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: Fehler CreatePipe in Excel 64bit
08.06.2020 11:14:30
Jan-Hendrik
Vielen Dank Karl-Heinz für die Hilfe. Jetzt funktioniert es. Ich habe wohl immer irgendeine Änderung vergessen. Also nochmal: Danke!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige