' Created: 08/10/06 09:29:30 by JefferyJ
Dim objWSHShell
Dim objFSO
Dim objNewsFile
Dim objFlagFile
Dim strNewsFile
Dim strLongFileDate
Dim strShortFileDate
Dim strNewsLastReadFlag
Dim strNewsLastRead
Dim strLatestNews
Dim strLocalSaveName
Dim strLocalTempName
Dim strLine
Const ForReading = 1
Const ForWriting = 2
Const strMotW = "<!-- saved from url=(0019)[URL unfurl="true"]http://www.mno.com/[/URL] -->"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strNewsFile = "\\server\folder\news.doc"
If not objFSO.FileExists(strNewsFile) then
Set objFSO = Nothing
wscript.quit
End if
Set objWSHShell = WScript.CreateObject("WScript.Shell")
strTemp = objWSHShell.ExpandEnvironmentStrings("%TEMP%")
strNewsLastReadFlag = strTemp & "\news.flg"
strLocalTempName = strTemp & "\news.tmp"
strLocalSaveName = strTemp & "\news.mht"
If objFSO.FileExists(strLocalTempName) then
objFSO.DeleteFile(strLocalTempName)
End if
If objFSO.FileExists(strLocalSaveName) then
objFSO.DeleteFile(strLocalSaveName)
End if
Set objNewsFile = objFSO.GetFile(strNewsFile)
' Get the last modified date of the news file
strLatestNews = cstr(objNewsFile.DateLastModified)
If not objFSO.FileExists(strNewsLastReadFlag) Then
Set objFlagFile = objFSO.OpenTextFile(strNewsLastReadFlag,ForReading,True) ' Or create the file
End if
Set objFlagFile = objFSO.GetFile(strNewsLastReadFlag) ' 'Bind' to the file (not the same as opening it)
if objFlagFile.Size > 0 then
Set objFlagFile = objFSO.OpenTextFile(strNewsLastReadFlag,ForReading)
strNewsLastRead = objFlagFile.ReadLine
objFlagFile.Close
Else
strNewsLastRead = "NULL"
End If
call ProcessFlagFile(strNewsLastReadFlag,strNewsLastRead,strLatestNews)
Set objWSHShell = nothing
Set objFSO = nothing
Set objNewsFile = nothing
Set objFlagFile = nothing
Set objWord = nothing
Set objIE = nothing
Set objLocalTempName = nothing
Set objLocalSaveName = nothing
'---------------------------------------------------------
Sub HereIsTheNews()
Set objWord = CreateObject("Word.Application")
If Err.Number <> 0 Then
On Error GoTo 0
Msg = "MS Word application not found."
MsgBox Msg,vbExclamation,Msg
Wscript.Quit
End If
On Error GoTo 0
Set objNewsFile = objWord.Documents.Add(strNewsFile)
objNewsFile.Activate
Set objNewsFile = objWord.ActiveDocument
objNewsFile.SaveAs strLocalTempName, 9
objNewsFile.close
objWord.quit
set objWord = nothing
'-----------------------------------------------------------
' Code to add the Mark Of The Web to the .mht file
Set objLocalTempName = objFSO.OpenTextFile(strLocalTempName,ForReading, False)
Set objLocalSaveName = objFSO.OpenTextFile(strLocalSaveName,ForWriting, True)
Do While Not objLocalTempName.AtEndOfStream
strLine = RTrim(LTrim(objLocalTempName.ReadLine))
If Len(strLine) > 0 Then
objLocalSaveName.WriteLine(strLine)
Else
If not eod = 1 then
objLocalSaveName.WriteLine(strMotW)
eod = 1
Else
objLocalSaveName.WriteLine("")
end if
End If
Loop
'-----------------------------------------------------------
Set objIE = CreateObject("InternetExplorer.Application")
If Err.Number <> 0 Then
On Error GoTo 0
Msg = "IE application not found."
MsgBox Msg,vbExclamation,Msg
Wscript.Quit
End If
On Error GoTo 0
objIE.visible = true
objIE.ToolBar = 0
objIE.Navigate "file://" & strLocalSaveName
End Sub
'-----------------------------------------------------------
Function ProcessFlagFile(strNewsLastReadFlag,strNewsLastRead,strLatestNews)
If strNewsLastRead = strLatestNews then ' do nothing apart from clear the objects
Set objWSHShell = nothing
Set objFSO = nothing
Set objNewsFile = nothing
Set objFlagFile = nothing
Set objWord = nothing
Set objIE = nothing
wscript.quit
Else 'The date in the flag file doesn't match the last modified date of the news.txt file so reading the news.
Call HereIsTheNews()
Set objFlagFile = objFSO.OpenTextFile(strNewsLastReadFlag, ForWriting)
objFlagFile.write strLatestNews
End If
End Function