Hi All
I am extracting all attachments from 4 different rtext fields and placing them into an attachments field.
This needs to be done as part of the migration process to webonise the database.
My script below works perfect on 90% of the attachments. it is the other 10% that it fails.
I have several attachments that have strange names
for example the embedded object name property within the rtext field will display “attn321” and the source property will show “requirements.doc”
When i go to extract these type of attachments it gives an error saying it cant be found. Now i would give it the option to extract the attachment “ATTN321” but not sure how to.
See the line of code below with ** Call att.ExtractFile(filepath) **
This is where it happens
when you have 15000 docs the manual option is not very helpful.
I appreciate any insight at all
Sub Initialize
' this agent loops through the 4 rtext fields of all main docs and removes attachments from these fields
' then they are renamed for reference as where they came from and extracted to hard drive
' they are then reattached to attachments field with there new name
Dim session As NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim view As notesview
Dim rttem As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim att As NotesEmbeddedObject
Set session = New NotesSession
Set db = session.CurrentDatabase
Dim object As NotesEmbeddedObject
Dim AttFound As Boolean
Dim AttCount As Integer
Dim FilePath As String
Dim count As Integer
Dim FileName(20) As String ' used for recording filenames so they can be removed
Dim RTNames(4) As String
RTNames(0) = "refdocs"
RTNames(1) = "DocDefinition"
RTNames(2) = "DocProcedure"
RTNames(3) = "DisplayDocs"
Set view = db.GetView("MainDocs")
Set doc = view.GetFirstDocument
Dim fileNum1 As Integer
fileNum1% = Freefile()
Open "C:\Temp\Attachments.txt" For Output As fileNum1% 'logfile
While Not doc Is Nothing
AttFound = False
For i = 0 To 3
If doc.docnumber(0) = "1000/02/1966" Then Stop
Set rtitem = doc.GetFirstItem( RTNAMES(i))
If Not rtitem Is Nothing Then
If ( rtitem.Type = RICHTEXT ) Then
Set rtnav =rtitem.CreateNavigator
REM Get attachments
If rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
AttCount = 0
Do
Set att = rtnav.GetElement()
FieldName = GetName(Cstr(i)) ' gets fieldname for Attachment name location assistance
filepath = "C:\temp\" & FieldName & "-" & ReplaceSubString(doc.docnumber(0), "/","-")& "-" & _
ReplaceSubString(att.source, " ","-") 'give file path and new name for attachment
'**** FAILS ON BELOW CODE ON SOME FILES *******
Call att.ExtractFile(filepath) 'extract to sys folder FAILS HERE
filename(AttCount) = att.source ' used for removing file attachments from field in below loop
AttCount = Attcount + 1
Set AttField = New NotesRichTextItem( doc, "Attachments" )
Set object = AttField.EmbedObject ( EMBED_ATTACHMENT, "", filepath) 'Attach file to attachments field
AttFound = True ' flagged for doc save
Write #fileNum1%, filepath
' Kill Filepath ' delete file from computer
Loop While rtnav.FindNextElement()
filename(Attcount +1) = "" 'gives below loop a kill point
x = 0
Do 'remove attachments from rtext field
' remove this way after all attachments have been processed otherwise some get skipped if removed in above loop
Set object = rtitem.GetEmbeddedObject( filename(x) )
Call object.Remove ' remove att from field cannot remove in rtnav object class so we go this way
x = x + 1
Loop While filename(x) <> ""
Write #fileNum1%,Doc.Docnumber(0) & " -- Field Total Attachments: " &Cstr(AttCount)
Count = Attcount + Count 'get total attachments processed
End If
End If
End If
Next
If AttFound Then Call doc.Save( True, True ) 'save doc if attachments were removed and attached
Set doc = view.GetNextDocument(doc)
Wend
Write #fileNum1%, Cstr(Count) & " Attachments processed total"
Close fileNum1% 'close logfile
End Sub
Function ReplaceSubString(strSource As String, strFrom As String, strTo As String) As String
Dim i As Integer, lenSource As Integer, lenFrom As Integer
lenSource = Len(strSource)
lenFrom = Len(strFrom)
ReplaceSubString = ""
If strFrom = "" Then Exit Function
For i = 1 To lenSource
If Strcompare(Mid(strSource, i, lenFrom), strFrom) = 0 Then
ReplaceSubString = ReplaceSubString & strTo
i = i + lenFrom - 1
Else
ReplaceSubString = ReplaceSubString & Mid(strSource, i, 1)
End If
Next
End Function
Function GetName(num As String) As String
Select Case num
Case "0"
GetName = "Reference"
Case "1"
GatName = "Definition"
Case "2"
GetName = "Procedure"
Case "3"
GetName = "Appendices"
Case Else
GetName = "Unknown-Location"
End Select
End Function
Hope someone can assist
Cheers
Mike