ich habe einen kleinen Agenten geschrieben, der Text in Feldern (z.B. Telefonnummer) suchen und ersetzen soll.
Ich bin mir sicher, dass das Script auch grundsätzlich noch stark optimierungsbedürftig ist.
Falscher Datentyp in Methode Assignment: Unknown wurde gefunden, Unknown wurde erwartet.
Ich vermute, dass dieser Fehler beim Ändern des Feldinhaltes auftritt, weiß aber nicht wieso.
Vielleicht könnt ihr mal einen Blick drauf werfen? (Das Speichern habe ich bewusst noch ausgeklammert. )
Zwischenfrage, hätte ich die Print-Anweisungen nicht in irgendeinem Log finden müssen?
Option Public
Option Declare
Sub Initialize
Dim CurrUIWs As New NotesUIWorkspace
Dim CurrSession As New NotesSession
Dim CurrDB As NotesDatabase
Dim MenuSelectionArray ( 2 ) As String
Dim MenuSelected As String
Dim Continue As Integer
Dim TmpNewLine As String
Dim dbname As Variant
Dim returnvalue As Boolean
Dim SearchFor As String
Dim ReplaceWith As String
Dim FindText As String
Dim ReplaceText As String
Dim mailpath As String
Dim mailowner As String
Dim doccol As NotesDocumentCollection
Dim doc As NotesDocument
TmpNewLine = Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13)
SearchFor = "(0)" ' What are we looking for
ReplaceWith = "" ' Replaced by
mailpath = "test\" ' Indicates the mail subdirectory name
MenuSelectionArray ( 0 ) = "Only for one mail database"
MenuSelectionArray ( 1 ) = "Only the global address book"
MenuSelectionArray ( 2 ) = "All users mail databases ($contacts)"
MenuSelected = CurrUIWs.Prompt ( 4 , "Please make your selection" , "Please select from the list below the task to be done by the agent." , "Only for one mail database" , MenuSelectionArray )
Select Case MenuSelected
Case "Only for one mail database"
MessageBox "Please select a mail database."
dbname=CurrUIWs.Prompt(13, "", "")
If Not IsArray(dbname) Then Exit Sub
MsgBox "selected database: " & dbname(1)
Call AskWhatToReplace (FindText,ReplaceText)
returnvalue = ChangeTheNumbers(dbname,"($Contacts)",FindText,ReplaceText)
Exit Sub
Case "Only the global address book"
MessageBox "Please select the names.nsf of your server."
dbname=CurrUIWs.Prompt(13, "", "")
If Not IsArray(dbname) Then Exit Sub
If Not dbname(1) = "names.nsf" Then
MsgBox "Sorry, but this is not the names.nsf of your server!"
Else
MsgBox "Current server: " & dbname(0)
Call AskWhatToReplace (FindText,ReplaceText)
returnvalue = ChangeTheNumbers(dbname,"People",FindText,ReplaceText)
End If
Exit Sub
Case "All users mail databases ($contacts)"
MessageBox "All users mail databases"
Call AskWhatToReplace (FindText,ReplaceText)
Set CurrDB = CurrSession.CurrentDatabase
Dim pos As Integer
Dim dbdir As New NotesDbDirectory(CurrDB.Server)
Dim db As NotesDatabase
Set db = dbdir.GetFirstDatabase(DATABASE)
While Not db Is Nothing
On Error 4060 GoTo Error4060
pos = InStr(db.FilePath, mailpath)
If pos = 1 Then
dbname(0) = db.Server
dbname(1) = db.Filename
dbname(2) = db.Title
returnvalue = ChangeTheNumbers(dbname,"($Contacts)",FindText,ReplaceText)
End If
GetNextDb: Set db = dbdir.GetNextDatabase()
Wend
Error4060: Resume GetNextDb
Exit Sub
Case Else
MessageBox "You did not select any menu item. Please try again." , 48 , "No value selected"
Print "ChangePhoneNumbers - Part 1 - Finished with Error ..."
Exit Sub
End Select
End Sub
Function FindAndReplace(SourceText As String,FindText As String,ReplaceText As String) As String
FindAndReplace = Replace(SourceText, FindText, ReplaceText)
End Function
Function ChangeTheNumbers(db As Variant, dbView As String, SearchFor As String, ReplaceWith As String) As Boolean
Dim strMyString As String
Dim mydb As NotesDatabase
Dim ses As New NotesSession
Dim view As NotesView
Dim doc As NotesDocument
Dim orig As String
Dim newvalue As String
Set mydb = ses.GetDatabase(db(0), db(1), False)
If Not mydb.IsOpen Then Call mydb.Open("", "")
If Not mydb.IsOpen Then
MsgBox "Error. Could not open database.", 16, "Error"
Print "ChangePhoneNumbers - Could not open database " + db(1)
Err = 0
ChangeTheNumbers = False
Else
Print "ChangePhoneNumbers - Replacing ... " + db(2)
Set view = mydb.getView(dbView)
Set doc = view.getFirstDocument
While Not (doc Is Nothing)
' CellPhoneNumber
orig = doc.CellPhoneNumber
newvalue = FindAndReplace (orig,SearchFor,ReplaceWith)
Call doc.replaceitemvalue ("CellPhoneNumber",newvalue)
' Call doc.save (True,True)
' HomeFaxPhoneNumber
orig = doc.HomeFaxPhoneNumber
newvalue = FindAndReplace (orig,SearchFor,ReplaceWith)
Call doc.replaceitemvalue ("HomeFaxPhoneNumber",newvalue)
' Call doc.save (True,True)
' OfficeFAXPhoneNumber
orig = doc.OfficeFAXPhoneNumber
newvalue = FindAndReplace (orig,SearchFor,ReplaceWith)
Call doc.replaceitemvalue ("OfficeFAXPhoneNumber",newvalue)
' Call doc.save (True,True)
' OfficeNumber
orig = doc.OfficeNumber
newvalue = FindAndReplace (orig,SearchFor,ReplaceWith)
Call doc.replaceitemvalue ("OfficeNumber",newvalue)
' Call doc.save (True,True)
' OfficePhoneNumber
orig = doc.OfficePhoneNumber
newvalue = FindAndReplace (orig,SearchFor,ReplaceWith)
Call doc.replaceitemvalue ("OfficePhoneNumber",newvalue)
' Call doc.save (True,True)
' PhoneNumber
orig = doc.PhoneNumber
newvalue = FindAndReplace (orig,SearchFor,ReplaceWith)
Call doc.replaceitemvalue ("PhoneNumber",newvalue)
' Call doc.save (True,True)
Print "ChangePhoneNumbers - Replaced! ... "
Set doc = view.Getnextdocument(doc)
Wend
ChangeTheNumbers = True
End If
End Function
Function AskWhatToReplace(FindText As String,ReplaceText As String)
Dim CurrUIWs As New NotesUIWorkspace
Dim askme As Variant
askme = CurrUIWs.Prompt (PROMPT_OKCANCELEDIT, _
"What to find", _
"Please enter the text to be replaced.","(0)")
If Not IsEmpty (askme) Then
FindText = askme
End If
askme = CurrUIWs.Prompt (PROMPT_OKCANCELEDIT, _
"Replace with", _
"Please enter the new text.")
ReplaceText = askme
End Function
Thema: Fehler im Agenten (Unknown gefunden, Unknown erwartet) (Gelesen 5716 mal)