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

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 :weep:

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

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. :weep:

Cheers

Amanda

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.

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.

Code:

---

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

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.

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

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 :

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 :cloud9: