Since Windows updates occurred, an API call to ShellExecuteEx(sExecuteInfo) crashes, saying:
unhandled exception at 0x75F7A529 (shell32.dll) Access violation
reading location 0x68686903
I have no clue what is wrong here, can you help me please?
Definition :
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
Hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Const STILL_ACTIVE As Long = &H103 ' Constant for the lpExitCode parameter of the GetExitCodeProcess API function.
Private Declare PtrSafe Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Long
Code:
Private Function ShellAndWait(ByVal szProgram As String, Optional ByVal szOptions As String, Optional ByVal iWindowState As Integer = vbHide) As Boolean
Dim lTaskID As Long
Dim lReturn As Long
Dim lExitCode As Long
Dim lResult As Long
Dim bShellAndWait As Boolean
Dim hInstance As Object
Dim lPriority As Long
On Error GoTo ErrorHandler
Dim sExecuteInfo As SHELLEXECUTEINFO
sExecuteInfo.cbSize = Len(sExecuteInfo)
sExecuteInfo.lpVerb = "open"
sExecuteInfo.lpFile = szProgram
sExecuteInfo.lpParameters = szOptions
sExecuteInfo.nShow = &H7 ' Parameter SW_SHOWMINNOACTIVE, (0x7) , displays the window as a minimized window. The active window remains active.
sExecuteInfo.fMask = &H8140 ' Parameter SEE_MASK_NO_CONSOLE (0x00008000), use to inherit the parent's console for the new process instead of having it create a new console
' Parameter SEE_MASK_NOASYNC (0x00000100), wait for the execute operation to complete before returning.
' Parameter SEE_MASK_NOCLOSEPROCESS (0x00000040), puts process id back in sExecuteInfo.hProcess
lPriority = &H100000 'PROCESS_MODE_BACKGROUND_BEGIN
lReturn = ShellExecuteEx(sExecuteInfo)
'Loop while the shelled process is still running.
Do
'lExitCode will be set to STILL_ACTIVE as long as the shelled process is running.
lResult = GetExitCodeProcess(sExecuteInfo.hProcess, lExitCode)
DoEvents
'iCount = iCount + 1
'Application.StatusBar = Str(iCount) + " iteration waited"
Loop While lExitCode = STILL_ACTIVE
bShellAndWait = True
Exit Function
ErrorHandler:
sErrMsg = Err.Description
bShellAndWait = False
End Function
Use way recommended by Microsoft.
MSDN article "Determine When a Shelled Process Ends" recommends approach through different API call and I can confirm it is working reliably. I'm posting code module (adopted from code in the article) here.
The following VBA module uses API call CreateProcessA(), waits for application to finish and returns ERRORLEVEL code as result:
Option Explicit
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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(CommandLine As String) As Long
Dim proc As PROCESS_INFORMATION
Dim Start As STARTUPINFO
Dim ret As Long
' Initialize the STARTUPINFO structure:
Start.cb = Len(Start)
' Start the shelled application:
ret& = CreateProcessA(vbNullString, CommandLine, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, Start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
If you store all the code as for example ShellExecModule, then you can call it as
Dim errorLevelValue As Long
errorLevelValue = ShellExecModule.ExecCmd(CommandLine)
Related
On the Microsoft Documentation page for AddressOf operator here, there are two blocks of code. However the first block of code gives the expected error List1 not defined. So, hoe do I make the example code work on Excel VBA?
Example code Block 1:
Option Explicit
Private Sub Form_Load()
Module1.FillListWithFonts List1
End Sub
Example code Block 2:
'Font enumeration types
Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(LF_FACESIZE) As Byte
End Type
Type NEWTEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
ntmFlags As Long
ntmSizeEM As Long
ntmCellHeight As Long
ntmAveWidth As Long
End Type
' ntmFlags field flags
Public Const NTM_REGULAR = &H40&
Public Const NTM_BOLD = &H20&
Public Const NTM_ITALIC = &H1&
' tmPitchAndFamily flags
Public Const TMPF_FIXED_PITCH = &H1
Public Const TMPF_VECTOR = &H2
Public Const TMPF_DEVICE = &H8
Public Const TMPF_TRUETYPE = &H4
Public Const ELF_VERSION = 0
Public Const ELF_CULTURE_LATIN = 0
' EnumFonts Masks
Public Const RASTER_FONTTYPE = &H1
Public Const DEVICE_FONTTYPE = &H2
Public Const TRUETYPE_FONTTYPE = &H4
Declare Function EnumFontFamilies Lib "gdi32" Alias _
"EnumFontFamiliesA" _
(ByVal hDC As Long, ByVal lpszFamily As String, _
ByVal lpEnumFontFamProc As Long, LParam As Any) As Long
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, _
ByVal FontType As Long, LParam As ListBox) As Long
Dim FaceName As String
Dim FullName As String
FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
LParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
EnumFontFamProc = 1
End Function
Sub FillListWithFonts(LB As ListBox)
Dim hDC As Long
LB.Clear
hDC = GetDC(LB.hWnd)
EnumFontFamilies hDC, vbNullString, AddressOf EnumFontFamProc, LB
ReleaseDC LB.hWnd, hDC
End Sub
Another thing is about the information on the same page that the AddressOf should be used in conjugation with the On Error Resume Next, however this isn't present on the given example. I would like to know how to use it too.
Thanks
I need to do the following:
Highlight a vertical range of cells, perform an array formula on that range, and push the results into my clipboard (preferably by pushing a hotkey).
For reference, here is the array formula: =LEFT(CONCAT("'"&TRIM(UNIQUE(A:A))&"',"),LEN(CONCAT("'"&TRIM(UNIQUE(A:A))&"',"))-1)
The A:A range above needs to dynamically reflect the cells highlighted (almost always a vertical column).
How do I refer to highlighted cells and put them into the array, and push results to the clipboard?
Here's a table and example
Column A
AAA
BBB
CCC
I'd highlight, for instance, cells A2:A4, press the macro button to run the formula
=LEFT(CONCAT("'"&TRIM(UNIQUE(A2:A4))&"',"),LEN(CONCAT("'"&TRIM(UNIQUE(A2:A4))&"',"))-1)
and copy the following text to the clipboard
'AAA','BBB','CCC'
Here's how I do this type of thing.
You can set the clipboard text using the Win API: it's also possible using DataObject but that seems pretty unreliable on Win10.
Sub tester()
Dim s As String, arr
If TypeName(Selection) = "Range" Then
arr = GetUniques(Selection)
If UBound(arr) = -1 Then Exit Sub 'no values found
s = "'" & Join(arr, "','") & "'"
'Debug.Print s
SetClipboard s 'set to clipboard: see below
End If
End Sub
Function GetUniques(rng As Range) 'as array
Dim c As Range, dict, v
Set dict = CreateObject("scripting.dictionary")
For Each c In rng.Cells
v = Trim(c.Value)
If Len(v) > 0 Then dict(v) = 0
Next c
GetUniques = dict.Keys
End Function
There may be some additions you'd need to make if your input lists are very large, depending on your database flavor. Eg. IN lists for Oracle are restricted to 1000 or fewer items so you need to use something like col IN([first 1000 items]) OR col IN([rest of items])
Edit - full Win API code for setting clipboard. Put this in a separate module. Will need adjustments if you're running 64-bit Excel.
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Public Function GetClipboard() As String
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Dim sUniText As String
Const CF_UNICODETEXT As Long = 13&
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
iStrPtr = GetClipboardData(CF_UNICODETEXT)
If iStrPtr Then
iLock = GlobalLock(iStrPtr)
iLen = GlobalSize(iStrPtr)
sUniText = String$(iLen \ 2& - 1&, vbNullChar)
lstrcpy StrPtr(sUniText), iLock
GlobalUnlock iStrPtr
End If
GetClipboard = sUniText
End If
CloseClipboard
End Function
I'm trying to use Waitable Timer objects in VBA, as I want to call something asynchronously with a delay of under 1 second (so no Application.OnTime) and with arguments (so no SetTimer API)
I haven't found someone attempting this anywhere else so I'm having to do it all from scratch, but I think it should be feasible. Here are the API declarations:
Public Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" ( _
ByVal lpTimerAttributes As Long, _
ByVal manualReset As Boolean, _
ByVal lpTimerName As Long) As Long
'The A meaning Ansi not Unicode https://jeffpar.github.io/kbarchive/kb/145/Q145727/
Public Declare Function SetWaitableTimer Lib "kernel32" ( _
timerHandle As Long, _
lpDueTime As fileTime, _
lPeriod As Long, _
pfnCompletionRoutine As Long, _
lpArgToCompletionRoutine As Long, _
fResume As Boolean) As Boolean
Which references a fileTime (struct)
'see https://social.msdn.microsoft.com/Forums/sqlserver/en-US/a28a32c6-df4e-41b9-94ce-6260812dd92f/problem-trying-to-run-32-bit-vba-program-on-a-64-bit-machine?forum=exceldev
Public Type fileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
I am calling the API like this:
'[...]
args = 1234 'public args As Long so it doesn't go out of scope while the timer is waiting
Dim timerHandle As Long
timerHandle = CreateWaitableTimer(0, False, 0)
Debug.Print GetSystemErrorMessageText(Err.LastDllError)
If Not SetWaitableTimer(timerHandle, absoluteDueTime, 0, AddressOf TimerCallbacks.pointerProc, VarPtr(args), False) Then
Debug.Print "Error: "; GetSystemErrorMessageText(Err.LastDllError)
End If
GetSystemErrorMessageText comes from Chip Pearson. absoluteDueTime is a fileTime variable which is set to Now + 1 second earlier in the procedure.
I'm getting in the immediate window:
0 - The operation completed successfully.
Error: 6 - The handle is invalid.
Meaning that CreateWaitableTimer appears to work but SetWaitableTimer does not.
FWIW TimerCallbacks.pointerProc looks like:
Public Sub pointerProc(ByVal argPtr As Long, ByVal timerLowValue As Long, ByVal timerHighValue As Long)
Debug.Print "pointerProc called"; Time
End Sub
(but I don't think that's where the error is...)
Oh, the problem is with the implicit byRef of everything:
Public Declare Function SetWaitableTimer Lib "kernel32" ( _
timerHandle As Long, _
lpDueTime As fileTime, _
lPeriod As Long, _
pfnCompletionRoutine As Long, _
lpArgToCompletionRoutine As Long, _
fResume As Boolean) As Boolean
Pointers must be passed byVal or they are immediately deferenced? Is this correct:
Public Declare Function SetWaitableTimer Lib "kernel32" ( _
byVal timerHandle As Long, _
byRef lpDueTime As fileTime, _
byRef lPeriod As Long, _
byVal pfnCompletionRoutine As Long, _
byVal lpArgToCompletionRoutine As Long, _
byRef fResume As Boolean) As Boolean
Not sure if all the byRefs are necessary
I have an application that is opened overnight by a batch job. The Workbook_Open event triggers a series of other workbooks to be updated using this code:
arrUpdateList = Array(DOWNLOAD_A, _
TRDUPDATE, _
CITUPDATE, _
FVUPDATE, _
FSUPDATE)
ThisWorkbook.Worksheets("Start").Activate
For i = LBound(arrUpdateList) To UBound(arrUpdateList)
Call UpdateItem(arrUpdateList(i))
Stop
Next i
Note: the variables in the array are simply file paths to excel documents.
Since approx. a week ago the process gets hung up because the first workbook that is opened doesn't close itself anymore. The first workbook (DOWNLOAD_A) contains the following code in its Workbook_Open event, which if i open the file manually, works perfectly.
Private Sub Workbook_Open()
Call DownloadFileAPI
DoEvents
Application.DisplayAlerts = False
Application.Quit
End Sub
How can I fix this problem? I have only been able to narrow the problem down to the fact that somehow excel doesn't close the workbook, because it either goes into an infinite loop, or the calling application somehow looses the reference. What can I do to further debug this?
For completeness's sake, here is the code in the calling workbook (the one being called up by the batchjob to kick off the process):
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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret&
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
'Shelled application needs to have an applicatin.quit command to close itself
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
As requested the other relevant procedures:
Public Sub UpdateItem(ByVal sItem As String)
Dim arr As Variant
Dim retval As Long
Dim CurrentDay As String
CurrentDay = DateValue(Now()) & " "
'Arr is split to check if there is a time value transferred
arr = Split(sItem, "|")
If UBound(arr) > 0 Then
'CDate converts the date time into a date; then if the time of the same day has already
'expired, there will be no wait. If the date time is still to come, the process will wait
Application.Wait CDate(CurrentDay & arr(1))
End If
'Log start
Call Writelog("Start: " & arr(0))
'Start process with shellwait (what if error occurs?)
retval = ExecCmd("excel.exe " & arr(0))
DoEvents
'Log end
Call Writelog("End: " & arr(0))
Erase arr
End Sub
The problem was caused by an add-in (Thomson Reuters EIKON). It could only be resolved by completely removing the COM add-in from Excel.
I was able to resolved the issue together with a colleague. The question of how I could have further debugged this is probably best answered remains.
I'll take a stab at it though, and say, I should have continued to strip away other code that also ran ontop of excel, until reaching a completely prestine Excel Version.
I am currently making some VBA code applicable for the new win7 machines on the job. This means that many function has to be added with the new 64-bit compatibility. I am currently following the guidelines from this homepage. I find them very useful and implemented following:
#If VBA7 Then
Declare PtrSafe Function CreateProcess Lib "kernel32" 'More code, see below.
#Else
Declare Function CreateProcess Lib "kernel32" 'More code, see below.
#EndIf
however, currently VBA is giving me following error message when I save my code:
NOTE: The code above contains the code described in the previous mentioned link: from jkp-ads. The error appears in the Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA". The full code can be found here.
What am I missing here?
Thanks!
Update
My full code:
Option Explicit
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId 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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#If VBA7 Then
private Declare PtrSafe Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (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 LongPtr
#Else
Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (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
#End If
Now, I want to emphasize a few things. First, I am running Excel 2003 and Windows XP 32bit. In addition to this I have not attempted to run the code yet. Why you may ask. The reason is simple. The editor comes up with a compile error before I am able to do anything. This Compile error can be seen in the picture above this piece of code. I have taken a screenshot of some of the code and especially where the compile error occurs. This is how it looks:
UpdateUpdate: Just found this article from MS support. It appears that the resolution is following: "To resolve this issue, ignore the "Compile error" and run the VBA code in the 64-bit version of the Office 2010 program." I still hope some solution exist though.
Further to my comment below your question (which you have ignored... by mistake I guess?) I believe you are getting that error because you have not specified all the parameters correctly.
Try this and it will compile just fine.
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId 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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#If VBA7 Then
Declare PtrSafe Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (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 LongPtr
#Else
Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (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
#End If
This is not a solution, but a path of investigation.
It looks like the compiler is looking at the stuff under #If VBA7 Then. But this shouldn't be happening at all in Excel 2003.
Try replacing whatever is under #If VBA7 Then with garbage, and add one declaration in the #Else part, e.g.
#If VBA7 Then
ksjdhfg lkjsdh fgkjh,dlgf sldjkgflsd g 'obvious syntax error
#Else
Const vOlder As String = "older VBA"
Declare Function CreateProcess Lib "kernel32" '... keep this part as it was
#End If
Then try to run this to see if it compiles:
Sub tester()
Debug.Print vOlder
End Sub
This should compile and run fine in Excel 2003 since it has an older version of VBA than 7.0. The stuff below #If VBA7 Then should get completely ignored (regardless of any syntax errors or anything else) and the stuff under #Else, e.g. vOlder, should be accessible.
Let us know if this helps you trace the error.