Thanks everyone for their responses.
Macropod, I'm sorry if I have offended with the multiple posts. I was just trying to capture as wide an audience as possible. In future I will only be using this site as it’s the only one my works network will allow me to log into. The details you posted on the other forum are correct and work exactly as required, until a corrupted word file is used.
On the word documents. I agree that the users should not be creating corrupt files and it amazes me how many I have been exposed to since starting this project. From my understanding the corruptions are caused by a combination of styles, section/page breaks and tables. The documents always start healthy but after a multiple updates to formatting problems occur.
I have examples of two types of corruption. In some when you open the file it shows a message “File corrupted” but clicking ok allows normal use of the file. The second type I’ve seen is where the file opens and can be used as normal. It allows full use of all features and copy pasting within the document. However as soon as you try and copy/paste to a different document it crashes out.
The first type seems to occur on large documents 200 plus pages. These are unlikely to be used by the tool but should still be handled correctly.
My understanding of the second type is that the structure of the source document has as developed over time, as changes are made part of the structure are lost. When pasting into a new document the lost structure cannot be duplicated so it falls over. Almost like driving from A to B with out recording the directions. You can happily get to C but cant tell somebody else how too because you cannot remember how you got to B.
The method I’m using for copy and pasting is actually calling the method used by the “Insert>File” menu option (InsertFile filename). I have also tried the Content.Copy, then Selection.paste method. Both methods experience the problem.
I would expect this process to only be executed for 2 or 3 files per operation under normal usage. However there is nothing to stop user attaching any number of files that they may require and there are plans to fully automate the process which would result in potentially 100ish files being processed in one execution.
I think that “fixing” the word files is unlikely so I have gone for testing the files when they are inputted. If there is a problem the details are explained to the user who can then fix it themselves and supply a working file. This might not be the most user friendly solution but its their own fault for not being able to use word properly.
The code I have used to make this check is attached.
------------------
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
' Check to see if data can be copied and pasted from a word file.
'-------------------------------------
' pstrPath File path
'-------------------------------------
' Returns True if the file is corrupt
' False if the file is ok
'-------------------------------------
Public Function fblnIsFileCorruptForCopyAndPaste(ByVal pstrPath As String) As Boolean
Const METHOD_NAME = "fblnIsFileCorruptForCopyAndPaste"
On Error GoTo Error
Dim wrdFile As Word.Document ' The word document
Dim wrdMain As Word.Document ' The file being created
Dim wrdMApp As Word.Application
Dim strName As String
Dim lHwnd As Long
Dim lProcessID As Long
' If the file is a word document, preview it...
If Right(pstrPath, Len(pstrPath) - InStrRev(pstrPath, ".") + 1) = ".doc" Then
Set wrdMApp = CreateObject("Word.Application")
' Add the preview
Set wrdFile = wrdMApp.Documents.Open(Filename:=pstrPath, ReadOnly:=True, Visible:=False)
Set wrdMain = wrdMApp.Documents.Add(Visible:=False)
wrdFile.Content.Copy
' Try pasting the data. If there is a problem
' it will fail here.
wrdMain.Select
wrdMApp.Selection.Paste
wrdFile.Close False
wrdMApp.Quit False
Set wrdFile = Nothing
Set wrdMain = Nothing
Set wrdMApp = Nothing
fblnIsFileCorruptForCopyAndPaste = False
Else
' Not a word file so corrupt
fblnIsFileCorruptForCopyAndPaste = True
End If
Exit Function
Error:
' Has a paste error occured?
If Err.Number = -2147417851 Then
' Set the return value
fblnIsFileCorruptForCopyAndPaste = True
' Close the temp target word file
wrdMain.Select
wrdMain.Close False
' Find the handle of the word application
lHwnd = FindWindow(vbNullString, wrdFile.Name & " (Read-Only) - " & wrdMApp.Caption)
If lHwnd = 0 Then
lHwnd = FindWindow(vbNullString, wrdFile.Name & " - " & wrdMApp.Caption)
End If
' Use the handle to get the ProcessId. This is returned "ByRef"
GetWindowThreadProcessId lHwnd, lProcessID
' Terminate the Process
TerminateProcess lProcessID
Exit Function
Else
' Its a general error, process as normal
' handle Error
End If
End Function
' Closes the process passed to the method
' Modified from example on
'
'-------------------------------------
' pstrPath File path
'-------------------------------------
' Returns True if a process was terminated
'-------------------------------------
Public Function TerminateProcess(ByVal plngPID As Long) As Boolean
Const METHOD_NAME = "TerminateProcess"
On Error GoTo Error
'---------------------------------------------------------------------------------------
' : Terminates a process. First checking to see if it is running or not.
' : Uses WMI (Windows Management Instrumentation) to query all running processes
' : then terminates ALL instances of the specified process
' : held in the variable strTerminateThis.
' :
' : ***WARNING: This will terminate a specified running process,use with caution!.
' : ***Terminating certain processes can effect the running of Windows and/or
' : ***running applications.
'---------------------------------------------------------------------------------------
Dim strTerminateThis As String ' The variable to hold the process to terminate
Dim objWMIcimv2 As Object ' CIMV2 Namespace
Dim objProcess As Object
Dim objList As Object
Dim intError As Integer
Dim intX As Integer
' Process to terminate,
strTerminateThis = "WINWORD.EXE"
' Connect to CIMV2 Namespace
Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
' Find the process to terminate
Set objList = objWMIcimv2.ExecQuery _
("select * from win32_process where name='" & strTerminateThis & "'")
' Set the return value to false, nothing terminated
TerminateProcess = False
' Check to see if any process were found, if not then the app isnt running
' and there is nothing to close
If objList.Count > 0 Then 'If 0 then process isn't running
' Find the matching process from the list of running process
For Each objProcess In objList
' Check the process ids match
If objProcess.processID = plngPID Then
intError = objProcess.terminate 'Terminates a process and all of its threads.
If intError = 0 Then
TerminateProcess = True
End If
Exit For
End If
Next
End If
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
Exit Function
Error:
' Handle Error
End Function
------------------------------
The points that may be worth noting are the two API calls, FindWindow and GetWindowThreadProcessID.
FindWindow caused much trouble, as I could not get the right combination of inputs to identify the correct window. Once the correct string had been created everything started to drop into place. FindWindow returns the window handle, this is used by GetWindowThreadProcessID to get the PID.
With the PID details the TerminateProcess example code could be easily be modified to only kill the required process.
I’m hoping that this work around will solve the issue.
I would again like to thank you all for your help.
Thanks
Christian