RE: Ebedded attchment db sh 22.Jun.12 11:08 AM a Web browser Applications Development All ReleasesAll Platforms
Dear Ram,
Hiii this is my code
Here CommentsHT is my richtext field and i have commented peace of code coz that code was not working
Dim session As New NotesSession
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim view As NotesView
Dim xlApp As Variant
Dim workbook As Variant
Dim row As Integer
Dim language As String
Dim namforEnteredBy As NotesName
Set uidoc=workspace.CurrentDocument
Set db = session.CurrentDatabase
Set doc=uidoc.Document
Set namforEnteredBy=session.CreateName(doc.EnteredBy(0))
row=1
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set workbook = xlApp.Workbooks
workbook.Add
Set excelsheet = xlApp.Workbooks(1).Worksheets(1)
'fill the excel sheet with data from docs--------------------------------------------------------------------------------------------
xlApp.cells(row,1).Value = doc.GetItemValue("CreationDate")(0)
%REM
Dim countembeded As Integer
Dim countattachments As Integer
Dim rtitem As Variant
countembedded=0
If doc.HasEmbedded Then
Forall o In doc.CommentsHT
countembedded=countembedded+1
' Messagebox( o.Name )
End Forall
'Else
' Messagebox "No embedded objects found"
End If
''worksheet.range("I"+Ltrim(Str(row))).value=countembedded
xlApp.cells(row,21).Value = countembedded
Set rtitem = doc.GetFirstItem("Body")
countattachments=0
If ( rtitem.Type = RICHTEXT ) Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) _
And ( o.FileSize > MAX ) Then
countattachments=countattachments+1
' Call o.ExtractFile ( "c:\reports\newfile" & Cstr(fileCount) )
' Call o.Remove
' Call doc.Save( True, True )
End If
End Forall
End If
Dim userdirectory As String
Dim userdrive As String
userdirectory = session.GetEnvironmentString("Directory",True)
'Msgbox "Userdirectoy is " & userdirectory
If (userdirectory Like "C:\*") Or (userdirectory Like "c:\*") Then
userdrive="c:\ExcelSheet.xls"
xlApp.activeworkbook.SaveAs("c:\ExcelSheet.xls")
Else
If (userdirectory Like "g:\*") Or (userdirectory Like "G:\*") Then
userdrive="g:\ExcelSheet.xls"
xlApp.activeworkbook.SaveAs("g:\ExcelSheet.xls")
End If
End If
'' Write #fileNum%
'' Close fileNum%
''xlApp.activeworkbook.SaveAs ("d:\ExcelSheet.xls.xls")
xlApp.quit
Exit Function
Return to top
. . . . RE: Ebedded attchment (db sh 22.Jun.12)
Print this page
