Edited by dansy on 16-Aug-01 17:04.
Hi,
hope someone can help with this as its driving me nuts.
I have a set of vba subs (see extract below) that open a directory and scans each file (opened read only) of a given mask for text of a given mask. Results are put into a new document for each source file with the .text element of the target find being pastespecial’d as a hyperlink in column 1 of the target document table row.
This works fine sometimes on the 3 test source files, sometimes processes 2 then bombs (error 5342) and sometimes only does the first file. The first file is always processed successfully and the target file it bombs on is successfully opened and the text found, the newdoc created and the table inserted, but fails on the first pastespecial with error 5342. This is because the ability to paste as a link is not available (in a newly created document!!) but I have no idea why. I have searched and searched for hits on 5342 to no avail.
Note that even when I stop the macro and go into the newdoc the Paste as Link option is not available. The target document is not protected.
Any help on this would be appreciated as I am tearing my hair out – and there aint much left to tear out!
—-CODE EXTRACT —
Sub req_extract_main
Set fs = Application.FileSearch
With fs
.LookIn = “D:vba code tester”
.FileName = “abcd-*.doc”
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
total_file_counter = .FoundFiles.Count
MsgBox “There were ” & total_file_counter & _
” REK*.DOC file(s) found.”
For i = 1 To .FoundFiles.Count
Documents.Open FileName:=.FoundFiles(i), ReadOnly:=True
Selection.HomeKey Unit:=wdStory ‘ Set pointer to start of doc
search_source = .FoundFiles(i) ‘ Set the source document to the first window
Set sourceDoc = Documents(.FoundFiles(i))
OpenNewDoc ‘ Create the target doc
ScanReq ‘ Scan the target and populate the New doc
Documents(.FoundFiles(i)).Close SaveChanges:=wdDoNotSaveChanges
Next i
Else
MsgBox “There were no suitable files found.”
End If
MsgBox “A total of ” & total_file_counter & ” files were searched of which, ” & yes_file_counter & ” had matching content.”
End With
End Sub
…
Sub ScanReq()
With sourceDoc.ActiveWindow.Selection.Find
.ClearFormatting
.Text = “[^#^#^#^#:^$^?:^#^#^#]” ‘ Set the search mask and find criteria
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do
sourceDoc.ActiveWindow.Selection.Find.Execute ‘ Perform the find then assign vars to the
‘ results
If sourceDoc.ActiveWindow.Selection.Find.Found Then
With sourceDoc.ActiveWindow.Selection
found_text = .Text
found_sentence = .Sentences(1)
found_page = .Information(wdActiveEndPageNumber)
End With
With newDoc.ActiveWindow.Selection ‘ Check insertion point is in the table then
If .Information(wdWithInTable) = True Then ‘ add a row and paste the results
.Rows.Add
End If
found_counter = found_counter + 1
sourceDoc.ActiveWindow.Selection.Copy ‘ copy the .text portion so we can paste the link
Documents(newDoc).ActiveWindow.Selection.PasteSpecial Link:=True, DataType:=wdPasteHyperlink
.MoveRight Unit:=wdCell, Count:=1
.Text = found_sentence
.MoveRight Unit:=wdCell, Count:=1
.Text = found_page
.MoveLeft Unit:=wdCell, Count:=2
.MoveDown
End With
Else
End If
Loop Until Selection.Find.Found = False
If found_counter > 0 Then ‘ We had at least one match so sort them
sort_results ‘ Sort the results
yes_file_counter = file_counter + 1
With newDoc
.SaveAs FileName:=”Results of scan of ” & Left(sourceDoc.Name, 9)
End With
Else
Documents(newDoc).Close SaveChanges:=wdDoNotSaveChanges
End If
End Sub
UPDATE — I NOW HAVE CONSISTENCY !
It bombs on the first paste on the second file EVERY time now.