我想将附件与其他数据一起导出到 Excel 工作表。我能够进行正常的出口。我还将附件从文档中提取到文件位置。现在需要做的是将它附加到excel单元格。
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uiView As NotesUIView
Dim doc As NotesDocument
Dim docCol As NotesDocumentCollection
Set uiView = ws.CurrentView
Set docCol = uiView.Documents
Set doc = docCol.GetFirstDocument
Dim xlApp As Variant
Dim xlsheet As Variant
Dim rtitem As Variant
Dim Ol As Variant
maxcols= 2
Set xlApp = CreateObject("Excel.Application")
xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.ReferenceStyle = 2
rows = 1
cols = 1
Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
xlsheet.Cells(rows,1).Value = "Created By"
xlsheet.Cells(rows,2).Value = "File/Attachment"
cols=1
rows=2
While Not doc Is Nothing
xlsheet.Cells(rows,1).Value = doc.CreatedBy(0)
Set rtitem = doc.GetFirstItem("FileUpload")
If ( rtitem.Type = RICHTEXT ) Then
Forall o In rtitem.EmbeddedObjects
If ( o.Type = EMBED_ATTACHMENT ) Then
Call o.ExtractFile ( "d:\temp\" & Cstr(doc.FileName(0)) )
End If
End Forall
xlsheet.Cells(rows,2).select
' xlsheet.Cells(rows,2).OLEObjects.Add Cstr(doc.FileName(0)), "d:\temp\" & Cstr(doc.FileName(0)), , True, , , Cstr(doc.FileName(0))
'Set Ol = xlApp.OLEObjects.Add(Cstr(doc.FileName(0)), "d:\temp\" & Cstr(doc.FileName(0)), True, False)
xlsheet.OLEObjects.Add( "", "d:\temp\" & Cstr(doc.FileName(0)), False, False).Select
End If
Set doc = docCol.GetNextDocument(doc)
rows=rows+1
cols=1
Wend
xlApp.Rows("1:1").Select
xlApp.Selection.Font.Bold = True
xlApp.Selection.Font.Underline = True
xlApp.Range(xlsheet.Cells(1,1), xlsheet.Cells(rows,maxcols)).Select
xlApp.Selection.Font.Name = "Arial"
xlApp.Selection.Font.Size = 8
xlApp.Selection.Columns.AutoFit
With xlApp.Worksheets(1)
.PageSetup.Orientation = 2
.PageSetup.centerheader = "Report - Confidential"
.Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date: &D"
.Pagesetup.CenterFooter = ""
End With
xlApp.ReferenceStyle = 1
xlApp.Range("A1").Select
xlApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
End Sub
请分享您的观点。
问候, Himanshu