Problem with recursive ShellExecuteEx on Wiindows XP but not under 2000

OK here are some snippets of the code...
Another function loops the code below...


'----Main Open code----
  If mvarFSO.FileExists(sFileName) Then
    mOfficeFunctions.OfficeThreading = True
    On Error Resume Next
    VBShellEx sFileName, 0
    If Err.Number <> 0 Then
      MsgBox "Error with ShellEx" & vbNewLine & _
             Err.Number & vbNewLine & _
             Err.Description & _
             Err.LastDllError, vbOKOnly + vbSystemModal
      Exit sub
    End If
Retry:
    lCount = 0
    bError = False
    While mOfficeFunctions.OfficeThreading And lCount < 150
      DoEvents
      VBSleepEx 200, True
      lCount = lCount + 1
      If lCount = 150 Then
        bError = True
      Else
        bError = False
      End If
    Wend
    If bError Then
      '-----Just stuff to ensure not wait forever...

OK the VBShellEx is as follows....



Public Function VBShellEx(ByVal sFileName As String, ByVal OwnerHwnd As Long) As Boolean
  Dim lHwndOwner As Long
  If OwnerHwnd = 0 Then
    lHwndOwner = GetDesktopWindow
  Else
    lHwndOwner = OwnerHwnd
  End If
  On Error Resume Next
  Dim lResult As Long
  Dim sQuoted As String
  Dim sShort As String
  Dim sStr As String
  Dim sei As SHELLEXECUTEINFO
  sShort = sFileName
  If IsNT Then
    sShort = Trim$(VBGetShortPathName(sFileName)) '----Short file names for NT, but not quoted "" for NT
    sQuoted = sShort
  Else
    sShort = sFileName
    sQuoted = QuoteFile(sShort) '----All others quoted file names "c:\program files\blah.doc" etc (Handles spaces
  End If
  With sei
    .cbSize = LenB(sei)
    .fMask = SEE_MASK_FLAG_DDEWAIT Or SEE_MASK_FLAG_NO_UI Or SEE_MASK_NOZONECHECKS
    .hwnd = lHwndOwner
    .lpVerb = "Open"
    .lpFile = sQuoted
    .nShow = 1
  End With
  lResult = ShellExecuteEx(sei) '----Causes App crash on second call... Only on XP... No message box or any clue... Even kills debugger (c++ attached to process)... Really cool...
  If lResult <= 32 Then
    '----Crap Shouldn't Happen though
    VBShellEx = false
  else
    VBShellEx = True
  End If
End Function


'----Word Event handler simply put
 mOfficeFunctions.OfficeThreading = False

     

'ADD THE FOLLOWING TO A .BAS MODULE
'
Public Declare Function FindExecutable Lib "shell32.dll" Alias _
    "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As _
    String, ByVal lpResult As String) As Long


Public Declare Function ShellExecute _
    Lib "shell32.dll" Alias _
    "ShellExecuteA" (ByVal _
    hwnd As Long, ByVal lpOperation As _
    String, ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
    Public Const SW_SHOWNORMAL = 1

Function LaunchMSDOC(Frm As Form, myDOC As String)
    Dim TName As String, DumbFile As String
    Dim BrowserExec As String * 255
    Dim RetVal As Long
    Dim FileN As Integer
    ' First, create a known, temporary DOC  file
    BrowserExec = Space(255)
    TName = "C:\tempdocuments.doc" 'temp document file to find association
    FileN = FreeFile
    Open TName For Output As #FileN ' Create temp DOC file
    Write #FileN, "MS WORD TEMP .DOC FILE"
    Close #FileN ' Close file
    ' Then find the application associated w
    '     ith it
    RetVal = FindExecutable(TName, DumbFile, BrowserExec)
    BrowserExec = Trim(BrowserExec)
    'If an application is found, launch it!


    If RetVal <= 32 Or IsEmpty(BrowserExec) Then ' Error
        MsgBox "Could Not find associated Browser", vbExclamation, _
        "Browser Not Found"
    Else
        RetVal = ShellExecute(Frm.hwnd, "open", BrowserExec, _
        myDOC, DumbFile, SW_SHOWNORMAL)
       
    End If
    ' End If
    Kill TName ' delete temp .DOC FILE
End Function


'execute 3 files

doevents

Call LaunchMSDOC(Form1, "c:\temp1.doc")
Call LaunchMSDOC(Form1, "c:\temp2.doc")
Call LaunchMSDOC(Form1, "c:\temp3.doc")

The reason your not getting an error message is because you are using

ON ERROR RESUME NEXT

Remove that line and run your code...your should us IF ERR instead to trap all your errors instead of using ON ERROR RESUME NEXT

remove ON ERROR RESUME NEXT and see what error it gives you.

Let me correct myself

example:

On Error GoTo iserror:
'c:\nothing.txt does not exists return me an error number

Shell "c:\nothing.txt", vbNormalFocus

iserror:
MsgBox Err

To elg1044

On error resume next
and If err.number = x
are inline error handling and the errors do get passed through

As to your first response using FindExecutable, this procedure has already been completed earlier on startup

For your own improvement
On Error Resume next and On error goto Failure catch the same exceptions in the error object the only difference is that the on error goto sends you to a label. On error resume next with an if statement is just as effective and in many case far more useful.

i.e.

on error resume next
x = 10 / 0
if err.number= 0 then
  msgbox "GOOD"
else
  msgbox err.description
end if

is the same as

on error goto Failuire
x = 10 / 0
msgbox "Good"
exit function 'or what ever

Failure:
  msgbox err.description

I just happen to prefer inline error handling.


As to the reason for the problem, I have subsequently discovered that some Antivirus under XP think my executable as it is also a MS Addin is a virus, and the anti virus terminates the application using endprocess, hence the reason there is no error and the debugger is also killed.
The only version of anti virus that I have found so far that does this is AVG 7.0, but with more testing I believe I will find more.

There I have answered my own question.

Moderators, cancel this question and delete it.