My “On error” routine works fine for the first error, but faced with another, It forgets about the “On error” subroutine, and stops the script.
Very annoying, and an error I haven’t had before.
Any good ideas is very valued.
Kind Regards
Tor-Olav Berntzen
Script as of now:
%REM
Agent ExportAttacedUtstyrdocs
Created Jun 30, 2010 by Tor-Olav Berntzen/SivIngBerntzen/NO
Description: Comments for Agent
%END REM
Option Public
Option Declare
Use “misc”
Use “ymse”
%INCLUDE “lsxbeerr.lss”
Const File_Path = "d:\t\oticUtstyr"
Const ScanDbSrv = “Dom_apps_srv/SivIngBerntzen/NO”
Dim retStr As String
Dim tmpint As Integer
Sub Initialize()
Dim db As NotesDatabase
Dim utstyrview As NotesView
Dim session As New NotesSession
Dim CurrentDoc As NotesDocument
Dim docEntry As NotesViewEntry
Dim notesRTItem, notesRTItem2 As NotesRichTextItem
Dim rtLink As NotesRichTextDocLink
Dim rtnav As NotesRichTextNavigator
Dim errcnt, linkcnt As Integer
Dim currentlog As New NotesLog("Script log")
Dim dirResult, tmpTxt,tmpFileName, fntmp,errtxt As String
Dim item As NotesItem
Dim errorcode, linenum As Integer
Dim linkDoc As NotesDocument
On Error GoTo ErrHandle
Dim linkDb As New NotesDatabase("", "")
dirResult = Dir$ (file_path , 16)
If dirResult = "" Then
MkDir file_path
End If
Call currentlog.Openfilelog( "d:\t\ScanDocLog_utstyr.log" )
currentlog.LogErrors = True
Set db = session.currentdatabase
Set linkdb = db '# Dummy assignment
Set utstyrview = db.getview("UtstyrMedLink")
utstyrview.Autoupdate = False
Set currentdoc = utstyrview.getfirstdocument
linenum = 0
Do Until currentdoc Is Nothing
linenum = linenum +1
Set notesRTitem = currentdoc.GetFirstItem("Body")
If Not (notesRTitem Is Nothing) Then
'# Remove LinkToSavedFile field
Set item = currentdoc.Getfirstitem("linkToSavedFile")
If Not item Is Nothing Then
Call item.Remove()
End If
Set item = New NotesItem(currentdoc, "LinkToSavedFile", Null)
Print currentdoc.id_nr(0) & " - LineNum " & Str(linenum)
Set rtNav = notesRTitem.Createnavigator()
rtnav.FindFirstElement(RTELEM_TYPE_DOCLINK)
While Not rtnav Is nothing
Set rtLink = rtNav.GetElement
If rtlink.DocUNID = String$(32, "0") Then
GoTo nextdoc
End If
' Dim linkDb As New NotesDatabase("", "")
'rtlink.ServerHint
If linkdb.Replicaid <> rtlink.Dbreplicaid Then
Delete linkdb
set linkDb = New NotesDatabase("", "")
Call linkDb.OpenByReplicaID(ScanDbSrv , rtlink.DbReplicaID)
End if
' Print (10/(linenum-linenum))
Set linkDoc = linkDb.GetDocumentByUNID(rtlink.DocUNID)
If Not (linkdoc is Nothing) then
'# Found doc OK!
'# Check for customer_id directory
dirResult = Dir$ (file_path & currentdoc.Kunde_NR(0), 16)
If dirResult = "" Then
MkDir file_path & currentdoc.Kunde_NR(0)
End if
Set notesRTitem = linkDoc.GetFirstItem("Body")
If ( notesRTitem.Type = RICHTEXT ) Then
ForAll o In notesRTitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
tmpFileName = currentdoc.Kunde_NR(0)&"\" & OnlyGoodDosChars(currentdoc.id_nr(0)) & "-" & OnlyGoodDosChars(linkdoc.sertifikatnr(0)) & o.Source
fntmp = Dir$(file_path & tmpFileName)
tmptxt = file_path & tmpFileName
Call o.ExtractFile( tmptxt )
item.Appendtotextlist(tmptxt)
Call Currentdoc.Save(false, false, false)
End If
End ForAll
End If
linkcnt = linkcnt+1
End If
If Not rtnav Is Nothing Then
Call rtnav.FindNextElement(RTELEM_TYPE_DOCLINK)
End If
wend
End If
Delete item
nextdoc:
Set currentdoc = utstyrview.Getnextdocument(currentdoc)
Loop
MessageBox "Links : " & linkcnt & "Errors : " & errcnt
Call currentlog.Close()
Exit Sub
ErrHandle:
Call currentLog.Logerror(Err ,Error$ & Str$(linkcnt) & " - " & currentdoc.id_nr(0)& "Line: " &linenum)
errcnt = errcnt +1
errorcode = Err
errtxt = Error$
MessageBox(Errtxt & " Line: " & Str(linenum))
GoTo nextdoc
End Sub
Function removeBadChars(InputStr As String) As String
dim retStr As String
Dim tmpint As Integer
retstr = CrRem(InputStr)
retstr = Trim$ (InputStr)
tmpint = InStr(retStr, "*")
Do Until tmpint=0
retstr = Left$(retstr,tmpint -1) & Mid$ (retstr, tmpint +1)
tmpint = InStr(retStr, "*")
Loop
tmpint = InStr(retStr, "/")
Do Until tmpint=0
retstr = Left$(retstr,tmpint -1) & Mid$ (retstr, tmpint +1)
tmpint = InStr(retStr, "/")
Loop
tmpint = InStr(retStr, "\")
Do Until tmpint=0
retstr = Left$(retstr,tmpint -1) & Mid$ (retstr, tmpint +1)
tmpint = InStr(retStr, "\")
Loop
tmpint = InStr(retStr, Chr(34))
Do Until tmpint=0
retstr = Left$(retstr,tmpint -1) & Mid$ (retstr, tmpint +1)
tmpint = InStr(retStr, "\")
Loop
removeBadChars = retstr
End Function