Consulting

Results 1 to 9 of 9

Thread: Solved: Terminate Adobe process?

  1. #1
    VBAX Regular andrew93's Avatar
    Joined
    Aug 2005
    Location
    Auckland, New Zealand
    Posts
    68
    Location

    Solved: Terminate Adobe process?

    Hi everyone

    Thanks to everyone who has helped me previously but I have another wee problem that I can't seem to resolve.

    I'm using Access 2003 and I have some scripts to automate the creation of pdf documents and e-mailing them using VBA. This works well.

    Sometimes after I have created and e-mailed the documents, the taskbar at the bottom of the screen (Win XP) shows a process / programme running titled 'Creating Adobe PDF'. It is not the little balloon you get, it's like the rectangular box at the bottom of the screen for each application that is currently running. Very often this appears after the 2nd invoice is created and it won't go away and does not respond to a right click -> close.

    The only way I can get it to disappear is to open the task manager and manually terminate 2 processes, namely 'acrodist.exe' & 'acrotray.exe'. Then this box disappears.

    Is it possible to terminate these 2 processes using VBA?

    TIA, Andrew

  2. #2
    VBAX Regular
    Joined
    Nov 2005
    Posts
    82
    Location
    Hi Andrew,

    For your acrotray.exe problem, go to Adobe, open preferences and under the miscellaneous options there is a check box for "show documents in task bar" - if you unclick it the tray should be cleared - but also you probably won't have open documents available from the bar either, so it isn't much of a fix unfortunately - it is also just "front end" because the application will, in all likelihood, still start.

    As for the other one - I can't even offer a similar miniscule hint of a solution.

    Sorry

    Amanda

  3. #3
    VBAX Regular andrew93's Avatar
    Joined
    Aug 2005
    Location
    Auckland, New Zealand
    Posts
    68
    Location
    Hi Amanda

    Thanks for the speedy reply. Unfortunately I can't see the option you described - I'm using Adobe Acrobat 6.0 Pro and there is no 'Misc' tab under Edit -> Preferences (or any other tabs for that matter, unless I'm suffering from a severe case of 'domestic blindness').

    I was also curious if there was a solution irrespective of the Adobe settings on the users' computers.

    Thanks anyway...

    Andrew

  4. #4
    VBAX Regular
    Joined
    Nov 2005
    Posts
    82
    Location
    Hi Andrew

    I've got version 7 so perhaps it isn't in version 6 - (why don't you download the latest - it is quite nice with some extra features).

    Sorry I can't help.

    Cheers

    Amanda

  5. #5
    VBAX Master Killian's Avatar
    Joined
    Nov 2004
    Location
    London
    Posts
    1,132
    Location
    Hi Andrew,

    Is there any way you could post the code that manages the PDF creation?
    It sounds like the application management in there needs to be fixed. Especially since you mention that it appears after the 2nd invoice - is there code to check for an existing instance of an Acrobat app before creating a new one?

    Another aspect of working with Adobe PDF apps I've come across is them getting locked up under automation because they're trying to do an online auto update.
    K :-)

  6. #6
    VBAX Regular andrew93's Avatar
    Joined
    Aug 2005
    Location
    Auckland, New Zealand
    Posts
    68
    Location
    Hi

    The code is pretty long but I will include the relevant parts. I'm using Access 2003 on Win XP Pro and Adobe Acrobat Pro 6.0. I created another thread recently concerning the creation of pdf documents - that thread can be viewed here if you want to see where the code came from.

    Part of a sub-routine attached to a button on a form :
    
    'Create the pdf file - calls the routine stored in mdlCreatePDF
    If RunReportAsPDF(strReport, strSave, UniqID) = False Then
    	MsgBox "The pdf version of the invoice could not be created", vbCritical, "Error - Invoice Not Saved"
    End If
    
    The module mdlCreatePDF :
    Option Compare Database
    
    Private Declare Sub CopyMemory Lib "kernel32" _
    			  Alias "RtlMoveMemory" (dest As Any, _
    									 source As Any, _
    									 ByVal numBytes As Long)
    
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
    				 Alias "RegOpenKeyExA" (ByVal hKey As Long, _
    										 ByVal lpSubKey As String, _
    										 ByVal ulOptions As Long, _
    										 ByVal samDesired As Long, _
    										 phkResult As Long) As Long
    
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    
    Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
    				 Alias "RegCreateKeyExA" (ByVal hKey As Long, _
    										 ByVal lpSubKey As String, _
    										 ByVal Reserved As Long, _
    										 ByVal lpClass As String, _
    										 ByVal dwOptions As Long, _
    										 ByVal samDesired As Long, _
    										 ByVal lpSecurityAttributes As Long, _
    										 phkResult As Long, _
    										 lpdwDisposition As Long) As Long
    
    Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
    				 Alias "RegQueryValueExA" (ByVal hKey As Long, _
    											 ByVal lpValueName As String, _
    											 ByVal lpReserved As Long, _
    											 lpType As Long, _
    											 lpData As Any, _
    											 lpcbData As Long) As Long
    
    Private Declare Function RegSetValueEx Lib "advapi32.dll" _
    				 Alias "RegSetValueExA" (ByVal hKey As Long, _
    										 ByVal lpValueName As String, _
    										 ByVal Reserved As Long, _
    										 ByVal dwType As Long, _
    										 lpData As Any, _
    										 ByVal cbData As Long) As Long
    
    Private Declare Function apiFindExecutable Lib "shell32.dll" _
    				 Alias "FindExecutableA" (ByVal lpFile As String, _
    										 ByVal lpDirectory As String, _
    										 ByVal lpResult As String) As Long
    
    Const REG_SZ = 1
    Const REG_EXPAND_SZ = 2
    Const REG_BINARY = 3
    Const REG_DWORD = 4
    Const REG_MULTI_SZ = 7
    Const ERROR_MORE_DATA = 234
    
    Const HKEY_CLASSES_ROOT = &H80000000		'WAS PUBLIC CONST BEFORE BUT WAS RED?????
    Const HKEY_CURRENT_USER = &H80000001		'DITTO
    Const HKEY_LOCAL_MACHINE = &H80000002	   'DITTO
    
    Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
    						 ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
    						 ' SYNCHRONIZE))
    
    Const KEY_WRITE = &H20006  '((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
    						 ' KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
    						 
    					    
    Public Function RunReportAsPDF(prmRptName As String, _
    							 prmPdfName As String, _
    							 UniqueID As Integer) As Boolean
    
    ' Returns TRUE if a PDF file has been created
    
    Dim AdobeDevice As String
    Dim strDefaultPrinter As String
    
    AdobeDevice = GetRegistryValue(HKEY_CURRENT_USER, _
    							 "Software\Microsoft\WIndows NT\CurrentVersion\Devices", _
    							 "Adobe PDF")
    
    If AdobeDevice = "" Then
    	MsgBox "You must install Acrobat Writer before using this feature"
    	RunReportAsPDF = False
    	Exit Function
    End If
    
    'Store the current default printer value
    strDefaultPrinter = Application.Printer.DeviceName
    
    Set Application.Printer = Application.Printers("Adobe PDF")
    
    'Create the Registry Key where Acrobat looks for a file name
    CreateNewRegistryKey HKEY_CURRENT_USER, "Software\Adobe\Acrobat Distiller\PrinterJobControl"
    
    'Put the output filename where Acrobat could find it
    SetRegistryValue HKEY_CURRENT_USER, _
    				 "Software\Adobe\Acrobat Distiller\PrinterJobControl", _
    				 Find_Exe_Name(CurrentDb.Name, CurrentDb.Name), _
    				 prmPdfName
    
    On Error GoTo Err_handler
    
    'Run the report (Note : I amended this code to filter the report for the unique ID)
    DoCmd.OpenReport prmRptName, acViewNormal, , "[Unique_id] = " & UniqueID
    
    'Restore default printer
    Set Application.Printer = Application.Printers(strDefaultPrinter)
    
    RunReportAsPDF = True
    
    Exit Function
    
    Err_handler:
    
    If Err.Number = 2501 Then	   ' The report did not run properly (ex NO DATA)
    	RunReportAsPDF = False
    	Set Application.Printer = Application.Printers(strDefaultPrinter)   'Added by AF
    	Exit Function
    Else
    	RunReportAsPDF = False	  ' The report did not run properly (anything else!)
    	MsgBox "Unexpected error #" & Err.Number & " - " & Err.Description
    	Set Application.Printer = Application.Printers(strDefaultPrinter)   'Added by AF
    	Exit Function
    End If
    
    End Function
    
    Public Function Find_Exe_Name(prmFile As String, _
    							 prmDir As String) As String
    
    Dim Return_Code As Long
    Dim Return_Value As String
    
    Return_Value = Space(260)
    Return_Code = apiFindExecutable(prmFile, prmDir, Return_Value)
    
    If Return_Code > 32 Then
    	Find_Exe_Name = Return_Value
    Else
    	Find_Exe_Name = "Error: File Not Found"
    End If
    
    End Function
    
    Public Sub CreateNewRegistryKey(prmPredefKey As Long, _
    							 prmNewKey As String)
    
    ' Example #1:  CreateNewRegistryKey HKEY_CURRENT_USER, "TestKey"
    '
    '			 Create a key called TestKey immediately under HKEY_CURRENT_USER.
    '
    ' Example #2:  CreateNewRegistryKey HKEY_LOCAL_MACHINE, "TestKey\SubKey1\SubKey2"
    '
    '			 Creates three-nested keys beginning with TestKey immediately under
    '			 HKEY_LOCAL_MACHINE, SubKey1 subordinate to TestKey, and SubKey3 under SubKey2.
    '
    Dim hNewKey As Long		 'handle to the new key
    Dim lRetVal As Long		 'result of the RegCreateKeyEx function
    
    lRetVal = RegOpenKeyEx(prmPredefKey, prmNewKey, 0, KEY_ALL_ACCESS, hKey)
    
    If lRetVal <> 5 Then
    	lRetVal = RegCreateKeyEx(prmPredefKey, prmNewKey, 0&, _
    							 vbNullString, REG_OPTION_NON_VOLATILE, _
    							 KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    End If
    
    RegCloseKey (hNewKey)
    
    End Sub
    
    Function GetRegistryValue(ByVal hKey As Long, _
    						 ByVal KeyName As String, _
    						 ByVal ValueName As String, _
    						 Optional DefaultValue As Variant) As Variant
    
    Dim handle As Long
    Dim resLong As Long
    Dim resString As String
    Dim resBinary() As Byte
    Dim length As Long
    Dim retVal As Long
    Dim valueType As Long
    	
    ' Read a Registry value
    '
    ' Use KeyName = "" for the default value
    ' If the value isn't there, it returns the DefaultValue
    ' argument, or Empty if the argument has been omitted
    '
    ' Supports DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY and REG_MULTI_SZ
    ' REG_MULTI_SZ values are returned as a null-delimited stream of strings
    ' (VB6 users can use SPlit to convert to an array of string)
    
    	
    ' Prepare the default result
    GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)
    
    ' Open the key, exit if not found.
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
    	Exit Function
    End If
    
    ' prepare a 1K receiving resBinary
    length = 1024
    ReDim resBinary(0 To length - 1) As Byte
    
    ' read the registry key
    retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), length)
    
    ' if resBinary was too small, try again
    If retVal = ERROR_MORE_DATA Then
    	' enlarge the resBinary, and read the value again
    	ReDim resBinary(0 To length - 1) As Byte
    	retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
    		length)
    End If
    
    ' return a value corresponding to the value type
    Select Case valueType
    	Case REG_DWORD
    		CopyMemory resLong, resBinary(0), 4
    		GetRegistryValue = resLong
    	Case REG_SZ, REG_EXPAND_SZ
    		' copy everything but the trailing null char
    		resString = Space$(length - 1)
    		CopyMemory ByVal resString, resBinary(0), length - 1
    		GetRegistryValue = resString
    	Case REG_BINARY
    		' resize the result resBinary
    		If length <> UBound(resBinary) + 1 Then
    			ReDim Preserve resBinary(0 To length - 1) As Byte
    		End If
    		GetRegistryValue = resBinary()
    	Case REG_MULTI_SZ
    		' copy everything but the 2 trailing null chars
    		resString = Space$(length - 2)
    		CopyMemory ByVal resString, resBinary(0), length - 2
    		GetRegistryValue = resString
    	Case Else
    		GetRegistryValue = ""
    '		RegCloseKey handle
    '		Err.Raise 1001, , "Unsupported value type"
    End Select
    
    'Close the registry key
    RegCloseKey handle
    
    End Function
    
    Function SetRegistryValue(ByVal hKey As Long, _
    						 ByVal KeyName As String, _
    						 ByVal ValueName As String, _
    						 Value As Variant) As Boolean
    						 
    ' Write or Create a Registry value
    ' returns True if successful
    '
    ' Use KeyName = "" for the default value
    '
    ' Value can be an integer value (REG_DWORD), a string (REG_SZ)
    ' or an array of binary (REG_BINARY). Raises an error otherwise.
    
    Dim handle As Long
    Dim lngValue As Long
    Dim strValue As String
    Dim binValue() As Byte
    Dim byteValue As Byte
    Dim length As Long
    Dim retVal As Long
    
    'Open the key, exit if not found
    If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then
    	Exit Function
    End If
    
    'Three cases, according to the data type in Value
    Select Case VarType(Value)
    	Case vbInteger, vbLong
    		lngValue = Value
    		retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD, lngValue, 4)
    	Case vbString
    		strValue = Value
    		retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, Len(strValue))
    	Case vbArray
    		binValue = Value
    		length = UBound(binValue) - LBound(binValue) + 1
    		retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, binValue(LBound(binValue)), length)
    	Case vbByte
    		byteValue = Value
    		length = 1
    		retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, byteValue, length)
    	Case Else
    		RegCloseKey handle
    		Err.Raise 1001, , "Unsupported value type"
    End Select
    
    'Close the key and signal success
    RegCloseKey handle
    
    'Signal success if the value was written correctly
    SetRegistryValue = (retVal = 0)
    
    End Function
    I'm a relative novice with VBA and I lifted the code as indicated in my other thread. I made a couple of minor changes but have added comments where I did so.

    I previewed this thread and the forum software seems to have upset the layout / formatting so apologies if the tabs appear all over the place. I'm not sure how to fix that in this forum.

    Can you see anything that is obviously incorrect? Like I said, it most often happens when I create 2 pdf documents in succession (i.e. click the buttono n the form a 2nd time to create a 2nd document, after the 1st one has finished).

    TIA, Andrew

  7. #7
    VBAX Master Killian's Avatar
    Joined
    Nov 2004
    Location
    London
    Posts
    1,132
    Location
    OK, well I don't think it's an issue with the code at all.
    The code itself never really concerns itself with Acrobat, it just fiddles around in the registry a bit, sets the Adobe PDF driver as the printer and sends the job to print.

    The problem, or so it appears to me, is that Adobe's work on Acrobat print drivers and Office integration, is questionable.

    Just to test my theory, I opened task manager and sorted the processes by name with the a's at the top. Then I opened up Word and printed a doc selecting, Abode PDF as the printer.
    'acrodist.exe' and 'acrotray.exe' appeared, the job was printed then 'Acro32Rd' started and the Acrobat Reader appeared with the document. Great.
    Then I closed Acrobat Reader and Word. Sure enough, 'acrodist.exe' and 'acrotray.exe' are still listed as running processes.

    Maybe the thinking behind this is that since distiller is quite a large app (compared to a normal print driver), it makes more sense to leave it loaded for any future PDF prints and the processes are all nicely tidied up at the end of the Windows session.
    This doesn't really explain why no UI is provided to unload it.
    Another explanation is slack program design. It wouldn't be the first time I've come across it with Acrobat' Office integration.
    K :-)

  8. #8
    VBAX Regular andrew93's Avatar
    Joined
    Aug 2005
    Location
    Auckland, New Zealand
    Posts
    68
    Location
    I appreciate your thoughts on this and your test. It helps explain what is going on, but the issue for me is that sometimes it happens on the 2nd document and at other times it doesn't do it! Anyway, the sooner we get a pdf writer incorporated into the Office suite, the better. Apparently this functionality will be built into the next version.....

    Thanks again
    Andrew

  9. #9
    VBAX Regular andrew93's Avatar
    Joined
    Aug 2005
    Location
    Auckland, New Zealand
    Posts
    68
    Location
    Ok so I have found some code courtesy of here that can be used to terminate a process. I modified the code slightly so that you pass the process name to the function and it will terminate that. It works well with the acrotray.exe per my first post in this thread as well as the ClickYes.exe programme in my other recent thread. Here is the code :

    Option Compare Database
    Option Explicit
    
    
    'These declarations are used by the "FindProcessID" routine
    Public Const TH32CS_SNAPPROCESS As Long = 2&
    Public Const MAX_PATH		   As Long = 260
    
    Public Type PROCESSENTRY32
    	   dwSize As Long
    	   cntUsage As Long
    	   th32ProcessID As Long
    	   th32DefaultHeapID As Long
    	   th32ModuleID As Long
    	   cntThreads As Long
    	   th32ParentProcessID As Long
    	   pcPriClassBase As Long
    	   dwFlags As Long
    	   szExeFile As String * MAX_PATH
    End Type
    
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwAccess As _
    Long, ByVal fInherit As Integer, ByVal hObject As Long) As Long
    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal _
    lFlags As Long, ByVal lProcessId As Long) As Long
    Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" _
    (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" _
    (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hPass As Long) As Long
    
    
    'These declarations are used by the enumerate windows & terminat process routines
    Const WM_DESTROY = &H2
    
    Public Wndw_Arry() As String
    Public Wndw_Ndx	As Integer
    
    Declare Function EnumWindows Lib "user32" _
    (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Declare Function GetWindowThreadProcessId Lib "user32" _
    (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    
    Public Function FindProcessID(pstrProcName As String) As Long
    
       Dim hSnapShot As Long
       Dim uProcess As PROCESSENTRY32
       Dim success As Long
    
       hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
       If hSnapShot = -1 Then
    	   GoTo ProcFailed
       End If
    
       uProcess.dwSize = Len(uProcess)
       success = ProcessFirst(hSnapShot, uProcess)
       If success = 1 Then
    	   Do
    		   Dim strUProcess As String
    		   strUProcess = ""
    		   Dim iNdx As Integer
    		   For iNdx = 1 To Len(uProcess.szExeFile)
    			 If (Right(Left(uProcess.szExeFile, iNdx), 1) > " ") Then
    				 strUProcess = strUProcess & Right(Left(uProcess.szExeFile, iNdx), 1)
    			   Else
    				   Exit For
    			   End If
    		   Next iNdx
    		   If (strUProcess = pstrProcName) Then
    			   FindProcessID = uProcess.th32ProcessID
    			   Exit Do
    		   End If
    	   Loop While ProcessNext(hSnapShot, uProcess)
       End If
    
       Call CloseHandle(hSnapShot)
       Exit Function
    
    ProcFailed:
       FindProcessID = 0
       Exit Function
    
    End Function
    
    Public Function fEnumWindowsCallBack _
    (ByVal hwnd As Long, ByVal lpData As Long) As Long
    
       Dim lResult	As Long
       Dim lThreadId  As Long
       Dim lProcessId As Long
       Dim sWndName   As String
       Dim sClassName As String
    
       ' This callback function is called by Windows (from the EnumWindows
       ' API call) for every window that exists.  It populates the aWindowList
       ' array with a list of windows that we are interested in.
       fEnumWindowsCallBack = 1
       sClassName = Space$(MAX_PATH)
       sWndName = Space$(MAX_PATH)
    
       lResult = GetClassName(hwnd, sClassName, MAX_PATH)
       sClassName = Left$(sClassName, lResult)
       lResult = GetWindowText(hwnd, sWndName, MAX_PATH)
       sWndName = Left$(sWndName, lResult)
    
       lThreadId = GetWindowThreadProcessId(hwnd, lProcessId)
    
       ReDim Preserve Wndw_Arry(Wndw_Ndx + 1)
       Wndw_Arry(Wndw_Ndx) = CStr(hwnd) & ";" & _
    					 sClassName & ";" & _
    					 CStr(lProcessId) & ";" & _
    					 CStr(lThreadId) & ";" & _
    					 sWndName
       Wndw_Ndx = Wndw_Ndx + 1
    
    End Function
    
    Public Sub CloseProcess(ProcName As String)
    
       Dim hwnd		  As Long
       Dim glHandle	  As Long
       Dim lhWnd		 As Long
       Dim lExitCode	 As Long
       Dim lngReturn	 As Long
       Dim lngProcessID  As Long
       Dim rtn		   As Long
       Dim glPID		 As Long
    
       Dim strHandle	 As String
       Dim strClass	  As String
       Dim strProcessID  As String
       Dim strThreadID   As String
       Dim strWindowName As String
       Dim strTableEntry As String
    
       Wndw_Ndx = 0
       ' Enumerate all parent windows for the process.
       Call EnumWindows(AddressOf fEnumWindowsCallBack, hwnd)
    
       lngProcessID = -1
       'Repeat the following loop for every ClickYes occurance
       While lngProcessID <> 0
    
    	   'Find the ProcessID of the program
    	   lngProcessID = FindProcessID(ProcName)
    
    	   ' Send a close command to each parent window.
    	   ' The app may issue a close confirmation dialog
    	   ' depending on how it handles the WM_CLOSE message.
    	   For Wndw_Ndx = 1 To UBound(Wndw_Arry) - 1
    		   strTableEntry = Wndw_Arry(Wndw_Ndx)
    		   strHandle = Left(strTableEntry, InStr(1, strTableEntry, ";") - 1)
    		 strTableEntry = Right(strTableEntry, Len(strTableEntry) - InStr(1, strTableEntry, ";"))
    		   strClass = Left(strTableEntry, InStr(1, strTableEntry, ";") - 1)
    		 strTableEntry = Right(strTableEntry, Len(strTableEntry) - InStr(1, strTableEntry, ";"))
    		   strProcessID = Left(strTableEntry, InStr(1, strTableEntry, ";") - 1)
    		 strTableEntry = Right(strTableEntry, Len(strTableEntry) - InStr(1, strTableEntry, ";"))
    		   strThreadID = Left(strTableEntry, InStr(1, strTableEntry, ";") - 1)
    		 strTableEntry = Right(strTableEntry, Len(strTableEntry) - InStr(1, strTableEntry, ";"))
    		   If (Len(strTableEntry) < 1) Then
    			   strWindowName = ""
    		   Else
    			   strWindowName = strTableEntry
    		   End If
    		   strTableEntry = ""
    
    		   If (lngProcessID = CLng(strProcessID)) Then
    			   glHandle = CLng(strHandle)
    			 rtn = SendMessage(glHandle, WM_DESTROY, 0&, 0&)
    		   End If
    	   Next Wndw_Ndx
       Wend
    
    End Sub
    I saved the code into a new module and close the process using a command like this :
    CloseProcess ("acrotray.exe")

    Andrew

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •