Larry,
This is more a vbs and html solution than Word and it isn't quite what you
asked for but I think the end result is something you will like. I've done
a script that adds a new item to your Internet Explorer context menu. If
you select some text on a web page and then right click the selected text,
instead of selecting 'Copy' you select the new item 'Research Entry'. The
script looks in your MyDocuments folder for a Word document named
"Web_Research.doc" and creates it if it doesn't already exist. It then
appends that document with the date and time, the URL of the page, the
document title for the page and the selected text. You get a pop up html
window to confirm that you want all this to happen and you can enter a typed
comment if you want to add a note to the text capture.
The easy way to get all this is to go to
http://yandlfiles.home.comcast.net/
and click the link in the upper left for my text archive programs (you will
want the second one which requires Word). The zip files contain a ReadMe
file, the core htm file and installation and uninstall scripts. All can be
opened in notepad allowing you to check for security concerns or modify the
scripts if you're comfortable with that sort of thing.
If you want do do this the manual way, it isn't that tough. Essentially, a
new registry key called HKEY_CURRENT_USER\Software\Microsoft\Internet
Explorer\MenuExt\Research_Entry is created. It is given a default value
that is the path and file name to the new htm file with the working
components of the script. There is also a value named "Flags" with DWord
value of 1.
The critical part of the new htm file (beside placing where the above
registry key points) are the lines below:
Set oWindow=window.external.menuArguments
Set oDocument=oWindow.document
docAddress=oDocument.URL
docTitle=oDocument.Title
When those lines are in a script launched from the IE context menu, the
appropriate information from the document that was right click is returned.
The entire contents of the html file I use is below:
<html>
<head>
<TITLE>Retrieve and Save Web Document Information</TITLE>
</head>
<BODY STYLE="BACKGROUND-COLOR:#EEEEEE; MARGIN:10">
<P ID=para1></P>
<P ID=para2></P>
<P ID=para3></P>
<P ID=para4></P>
<P ID=para5></P>
<p><font size="4" color="red">Enter any comments to go with the document
information</font></p>
<TEXTAREA ID="comments" cols="52"></TEXTAREA>
<P ID=para6></P>
<P ID=para7></P>
<p><input type="button" name="B1" value=" SAVE TO WEB_RESEARCH.DOC ">
<script language="VBScript"><!--
Dim oWindow, oDocument, docAddress, docTitle, oSelect, oSelectRange,
strSelection, WSH, fso
Set oWindow=window.external.menuArguments
Set oDocument=oWindow.document
docAddress=oDocument.URL
docTitle=oDocument.Title
If docTitle = "" Then
docTitle = "(no document title)"
End If
Set oSelect=oDocument.selection
Set oSelectRange=oSelect.createRange()
strSelection=oSelectRange.text
Set WSH = CreateObject ("WScript.shell")
strMyDocs = WSH.SpecialFolders("MyDocuments")
' strMyDocs = "C:\Test\myfolder"
Set fso = CreateObject("Scripting.FileSystemObject")
Dim dy, mo, yr, hr, mi, se, dyStr, moStr, yrStr, hrStr, miStr, seStr, serStr
mo=month(Now)
dy=day(Now)
yr=year(Now)
hr=hour(Now)
mi=minute(Now)
se=second(Now)
'
If len(CStr(mo))=1 Then
moStr="0"&CStr(mo)
Else
moStr=CStr(mo)
End If
'
If len(CStr(dy))=1 Then
dyStr="0"&CStr(dy)
Else
dyStr=CStr(dy)
End If
'
yrStr=Right(CStr(yr),2)
'
If len(CStr(hr))=1 Then
hrStr="0"&CStr(hr)
Else
hrStr=CStr(hr)
End If
'
If len(CStr(mi))=1 Then
miStr="0"&CStr(mi)
Else
miStr=CStr(mi)
End If
'
If len(CStr(se))=1 Then
seStr="0"&CStr(se)
Else
seStr=CStr(se)
End If
'
serStr="T"&yrStr&moStr&dyStr&hrStr&miStr&seStr
document.all("para1").innerText="Information collected at: " & Now
document.all("para2").innerText="Document URL = " & docAddress
document.all("para3").innerText="Document Title = " & docTitle
document.all("para4").innerText="Document Last Modified on " &
oDocument.LastModified
If strSelection <> "" Then
document.all("para5").innerText="Document Selection = " & strSelection
End If
document.all("para6").innerText="The info will be bookmarked as " & serStr &
" in Word document below"
document.all("para7").innerText=strMyDocs & "\Web_Research.doc"
Sub B1_onClick
On Error Resume Next
Dim oWd, doc
Set oWd = CreateObject("Word.Application")
If Err.Number <> 0 Then
Alert "Problem opening Word or initiating some other object"
Window.Close
End If
If fso.FileExists(strMyDocs & "\Web_Research.doc") Then
Set doc = oWd.documents.open(strMyDocs & "\Web_Research.doc")
Else
Set doc = oWd.documents.add
doc.SaveAs strMyDocs & "\Web_Research.doc"
End If
Dim rngCurrent
oWd.Selection.WholeStory
oWd.Selection.MoveRight
oWd.Selection.TypeParagraph
oWd.Selection.TypeText("Information gathered at " & Now)
oWd.Selection.TypeParagraph
Set rngCurrent = oWd.Selection
oWd.ActiveDocument.Bookmarks.Add serStr,rngCurrent
oWd.Selection.TypeText("From ")
oWd.Selection.Font.Color=255
oWd.Selection.TypeText("URL ")
oWd.Selection.Font.Color=0
oWd.Selection.TypeText(docAddress)
oWd.Selection.TypeParagraph
oWd.Selection.TypeText("Document Title = " & docTitle & " then last modified
on " & oDocument.LastModified)
If strSelection <> "" Then
oWd.Selection.TypeParagraph
oWd.Selection.Font.Color=255
oWd.Selection.TypeText("Selected Text = ")
oWd.Selection.Font.Color=0
oWd.Selection.TypeText(strSelection)
End If
If comments.Value <> "" Then
oWd.Selection.TypeParagraph
oWd.Selection.Font.Color=255
oWd.Selection.TypeText("Comment = ")
oWd.Selection.Font.Color=0
oWd.Selection.TypeText(comments.Value)
End If
oWd.Selection.TypeParagraph
oWd.Selection.TypeText("********************************")
oWd.ActiveDocument.Save
oWd.ActiveDocument.Close
oWd.Quit
Set oWd = Nothing
Window.Close
End Sub
Set WSH = Nothing
--></script>
</BODY>
</html>