PDA

View Full Version : Solved: Terminate Adobe process?



andrew93
12-06-2005, 04:11 PM
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

Amanda1
12-06-2005, 10:06 PM
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:

andrew93
12-06-2005, 11:28 PM
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

Amanda1
12-06-2005, 11:31 PM
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

Killian
12-07-2005, 02:49 AM
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.

andrew93
12-07-2005, 12:47 PM
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 (http://www.vbaexpress.com/forum/showthread.php?t=6210) 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

Killian
12-08-2005, 05:45 AM
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.

andrew93
12-08-2005, 12:33 PM
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

andrew93
12-22-2005, 05:35 PM
Ok so I have found some code courtesy of here (http://www.openitx.com/archives/archives.asp?l=vb-access-l&i=481115) 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 :cloud9: