Sunday, March 18, 2012

Function for Replace substring in Lotus script

 @Replacesubstring in Formula language. Here you go for the lotus script function of the Replace sub-string


Function ReplaceSubString (ByVal SrcStr As String, ByVal OrigSubStr As String,ByVal RplcSubString As String) As String
' Dimension variables:
Dim NextPos As Long
Dim OrigSubStringLen As Integer
Dim RplcSubStringLen As Integer
Dim NStr As String

' Make copy of SourceString
NStr = SrcStr
' Calculate the Original SubString and Replacement SubString lengths only once:
OrigSubStringLen = Len(OrigSubStr)
RplcSubStringLen = Len(RplcSubString)
' Find First SubString to Replace
NextPos = InStr(NStr, OrigSubStr)

' Loop searching for substrings to replace
Do Until NextPos = 0
' Replace substring with new substring
NStr = Left$(NStr, NextPos-1) + RplcSubString + Mid$(NStr, NextPos +OrigSubStringLen )

' Find the next substring to replace
NextPos = InStr(NextPos+RplcSubStringLen, NStr, OrigSubStr)
Loop

' Return the New String
ReplaceSubString = NStr
End Function

Lotus script function for creating folder at local computer

//*********Function for creation of folder at local computer***************//

Function CheckMakeFolder ( root As String , leaf As String, subleaf As String) As String
    Dim strPath As String
    Dim strPath1 As String
    strPath = root & "\" & leaf
    'MsgBox (strpath)
    If Not DirExists (strPath) Then
        MkDir strPath
    End If
   
    strPath1 = strPath & "\" & subleaf
   
    If Not DirExists (strPath1) Then
        MkDir strPath1
    End If
   
       
    'End If
    CheckMakeFolder = strPath1
   
End Function
 
//******Function for validating the Directories from Local computer****************//

Function DirExists (strPath As String) As Boolean  
DirExists = (Dir$ (strPath ,16 ) <> "" )
    'MsgBox(DirExists)
End Function

Code for extracting the attachment, and create the folder and save the attachment with folder on local computer.


Paste this below code in the Agent, and change the view name.

Option Public
Option Declare

Sub Initialize
    On Error GoTo Error_Handling
    Dim sess As New NotesSession
    Dim db As NotesDatabase
    Dim coll As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim view As NotesView
    Dim spItem As string
   
    Dim rtitem As Variant
    Dim filename As Variant
    Dim EnsureFolder As String
    Dim EnsureFolder1 As String
    Dim path1 As String
   
   
    Dim SplitString As String
    Dim Delimiter As String
    Dim retSplit As Variant
   
    Dim i As Integer
    Dim j As Integer
   
    Set db = sess.currentdatabase
    'Set coll = db.unprocesseddocuments
    Set view = db.getview("Data\By Country_I")
    Set doc = view.getfirstdocument
    While Not doc Is Nothing
        Set rtitem = doc.GetFirstItem( "data_attachement" )
        If Not rtitem Is Nothing Then
            If ( rtitem.Type = RICHTEXT ) Then
                Print doc.data_country(0)& "pROCESS" &doc.data_keyword(0)
                For i=0 To UBound(doc.data_country)
                  
                    For j=0 To UBound(doc.data_keyword)
              
                        SpItem = ReplaceSubString(doc.data_keyword(j) ,"/", "+")
                        Print "Error" &SpItem
                        'Exit sub
                        Path1 = CheckMakeFolder("c:\TEST2012", doc.data_country(i), SpItem)
                      
                        If doc.HasEmbedded Then
                  
                    ForAll o In rtitem.EmbeddedObjects
                              
                                If ( o.Type = EMBED_ATTACHMENT ) Then
                        Print o.Source
                        Call o.ExtractFile(Path1 & "\" & o.Source )
                        Print path1 &"Done"
                        Call doc.Save( True, True )
                    End If
                    'Call doc.Save( True, True )
                End ForAll
                      
                    End If
                  
                Next
                Next    'Call doc.Save( True, True )
            End If
        End If
        Set doc = view.getnextdocument(doc)
    Wend
   
Error_Handling:
    '// Capture the error "Document already exists in this collection" - not a fatal error, just means that it already exists in the list
    If Err = 4469 Then
        Resume Next
    Else
        '    Print "Error: " & Error$ & " (" & Err & ") on line " & Erl
        MsgBox("Error: " & Error$ & " (" & Err & ") on line " & Erl)
        Exit Sub
    End If
   
End Sub
Function CheckMakeFolder ( root As String , leaf As String, subleaf As String) As String
    Dim strPath As String
    Dim strPath1 As String
    strPath = root & "\" & leaf
    'MsgBox (strpath)
    If Not DirExists (strPath) Then
        MkDir strPath
    End If
   
    strPath1 = strPath & "\" & subleaf
   
    If Not DirExists (strPath1) Then
        MkDir strPath1
    End If
   
      
    'End If
    CheckMakeFolder = strPath1
   
End Function

REM
Function DirExists (strPath As String) As Boolean  
DirExists = (Dir$ (strPath ,16 ) <> "" )
    'MsgBox(DirExists)
End Function

Function ReplaceSubString (ByVal SrcStr As String, ByVal OrigSubStr As String,ByVal RplcSubString As String) As String
' Dimension variables:
Dim NextPos As Long
Dim OrigSubStringLen As Integer
Dim RplcSubStringLen As Integer
Dim NStr As String

' Make copy of SourceString
NStr = SrcStr
' Calculate the Original SubString and Replacement SubString lengths only once:
OrigSubStringLen = Len(OrigSubStr)
RplcSubStringLen = Len(RplcSubString)
' Find First SubString to Replace
NextPos = InStr(NStr, OrigSubStr)

' Loop searching for substrings to replace
Do Until NextPos = 0
' Replace substring with new substring
NStr = Left$(NStr, NextPos-1) + RplcSubString + Mid$(NStr, NextPos +OrigSubStringLen )

' Find the next substring to replace
NextPos = InStr(NextPos+RplcSubStringLen, NStr, OrigSubStr)
Loop

' Return the New String
ReplaceSubString = NStr
End Function