我想基于.xls格式而不是.csv格式的列值导出CSVview。现在它以.csv出口。我尝试将文件名替换为.xls,但文件不会对MS Excel和Open Office开放。能否请你帮忙?
以下是代码:
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim CSVview As NotesView
Dim lookupview As NotesView
Dim exportmaildoc As NotesDocument
Dim pathdoc As NotesDocument
Dim object As NotesEmbeddedObject
Dim exporttoid As Variant
Dim datafileName As String
Dim filepath As String
Dim filenames As Variant
Set db=session.CurrentDatabase
Set CSVview=db.GetView("Top10DCV")
datafileEnd$ = "ESI_Top_10_Density_Offenders.csv"
Set lookupview = db.GetView("lookupkeyword")
Set pathdoc = lookupview.GetDocumentByKey("UploadFilePath")
If Not pathdoc Is Nothing Then
filepath = pathdoc.Keyword(0)
datafileName = filepath & datafileEnd$
Else
MsgBox "File path not found."
Exit Sub
End If
datafileNum = FreeFile()
Open datafileName For Output As datafileNum
Call ViewCSVPrint ( CSVview, datafileName )
Set exportmaildoc = lookupview.GetDocumentByKey("Density")
If Not exportmaildoc Is Nothing Then
exporttoid = exportmaildoc.Keyword
End If
Dim maildoc As NotesDocument
Set maildoc = db.CreateDocument
Dim rtitem As NotesRichTextItem
maildoc.subject = "Report export file"
Set rtitem = New NotesRichTextItem(maildoc, "Body" )
Call rtitem.AppendText("Please find the report below:" )
Call rtitem.AddNewLine( 2 )
Set object = rtitem.EmbedObject( EMBED_ATTACHMENT, "", datafileName)
Dim allofthem() As String
ReDim Preserve allofthem(UBound(exporttoid)) As String
For q = 0 To UBound(exporttoid)
allentries = allentries + 1
allofthem(q) = exporttoid(q)
Next
maildoc.sendto = allofthem
If maildoc.sendto(0) <> "" Then
Call maildoc.send(False)
End If
Exit Sub
End Sub
----------------------------------------------------------------------------
Sub ViewCSVPrint (CSVview As NotesView, FileName As String )
Dim x As Integer
Dim vc As NotesViewEntryCollection
'CSV Static Headers
Print #datafileNum%,(Format$("DimWt/ActWt%","")&";"&Format$("DimWt-ActWt","")&";"&Format$("MT/PN","")& ";"&Format$("Model","")&";"&Format$("PkgVol/ProdVol","")&";"&Format$("PkgProdL(mm)","")& ";"&Format$("PkgProdW(mm)","")& ";"&Format$("PkgProdD(mm)","")&";"&Format$("PkgProdVol(CubicMeters)","")&";"&Format$("PkgProdWt(kg)","")& ";"&Format$("PkgProdDimWt","")& ";"&Format$("ProdL(OD)mm","")&";"&Format$("ProdW(OD)mm","")&";"&Format$("ProdD(OD)mm","")& ";"&Format$("ProdVol(CubicMeters)","")& ";"&Format$("ProdWt(kg)","")&";"&Format$("ProdDensity","")&";"&Format$("PkgProdDensity","")&";"&Format$("Pkg/ProdVolRatio",""))
Const NotesMacro$ = {@DBColumn("":"";@dbname;"Top10DCV";2)}
retval = Evaluate(NotesMacro$)
For t = 0 To UBound(retval)
Set vc = CSVview.GetAllEntriesByKey(retval(t), True)
Set v2entry = vc.GetFirstEntry
doccount1 = 0
Do While doccount1 < 10 And Not v2entry Is Nothing
ReDim Preserve tmpArray3(tmpcount3)
ReDim Preserve tmpArray4(tmpcount4)
ReDim Preserve tmpArray5(tmpcount5)
ReDim Preserve tmpArray6(tmpcount6)
ReDim Preserve tmpArray7(tmpcount7)
ReDim Preserve tmpArray8(tmpcount8)
ReDim Preserve tmpArray9(tmpcount9)
ReDim Preserve tmpArray10(tmpcount10)
ReDim Preserve tmpArray11(tmpcount11)
ReDim Preserve tmpArray12(tmpcount12)
ReDim Preserve tmpArray13(tmpcount13)
ReDim Preserve tmpArray14(tmpcount14)
ReDim Preserve tmpArray15(tmpcount15)
ReDim Preserve tmpArray16(tmpcount16)
ReDim Preserve tmpArray17(tmpcount17)
ReDim Preserve tmpArray18(tmpcount18)
ReDim Preserve tmpArray19(tmpcount19)
ReDim Preserve tmpArray20(tmpcount20)
ReDim Preserve tmpArray21(tmpcount21)
tmpArray3(tmpcount3) = v2entry.ColumnValues(3)
tmpArray4(tmpcount4) = v2entry.ColumnValues(4)
tmpArray5(tmpcount5) = v2entry.ColumnValues(5)
tmpArray6(tmpcount6) = v2entry.ColumnValues(6)
tmpArray7(tmpcount7) = v2entry.ColumnValues(7)
tmpArray8(tmpcount8) = v2entry.ColumnValues(8)
tmpArray9(tmpcount9) = v2entry.ColumnValues(9)
tmpArray10(tmpcount10) = v2entry.ColumnValues(10)
tmpArray11(tmpcount11) = v2entry.ColumnValues(11)
tmpArray12(tmpcount12) = v2entry.ColumnValues(12)
tmpArray13(tmpcount13)= v2entry.ColumnValues(13)
tmpArray14(tmpcount14)= v2entry.ColumnValues(14)
tmpArray15(tmpcount15)= v2entry.ColumnValues(15)
tmpArray16(tmpcount16)= v2entry.ColumnValues(16)
tmpArray17(tmpcount17)= v2entry.ColumnValues(17)
tmpArray18(tmpcount18)= v2entry.ColumnValues(18)
tmpArray19(tmpcount19)= v2entry.ColumnValues(19)
tmpArray20(tmpcount20)= v2entry.ColumnValues(20)
tmpArray21(tmpcount21)= v2entry.ColumnValues(21)
doccount1 = doccount1 + 1
Print #datafileNum%,(Format$(tmpArray3(tmpcount3),"0.00%")&";"&Format$(tmpArray4(tmpcount4),"0.00") & ";" & tmpArray5(tmpcount5) & ";" & tmpArray6(tmpcount6) & ";" & Format$(tmpArray7(tmpcount7),"0.00")&";"&Format$(tmpArray8(tmpcount8),"0.0")&";"&Format$(tmpArray9(tmpcount9),"0.00")&";"&Format$(tmpArray10(tmpcount10),"0.0")&";"&Format$(tmpArray11(tmpcount11),"0.000")&";"&Format$(tmpArray12(tmpcount12),"0.00")&";"&Format$(tmpArray13(tmpcount13),"0.00")&";"&Format$(tmpArray14(tmpcount14),"0.0")&";"&Format$(tmpArray15(tmpcount15),"0.0")&";"&Format$(tmpArray16(tmpcount16),"0.0")&";"&Format$(tmpArray17(tmpcount17),"0.00")&";"&Format$(tmpArray18(tmpcount18),"0.0")&";"&Format$(tmpArray19(tmpcount19),"0.00")&";"&Format$(tmpArray20(tmpcount20),"0.00")&";"&Format$(tmpArray21(tmpcount21),"0.00"))
Set v2entry = vc.GetNextEntry(v2entry)
tmpcount3=tmpcount3 + 1
tmpcount4=tmpcount4 + 1
tmpcount5=tmpcount5 + 1
tmpcount6=tmpcount6 + 1
tmpcount7=tmpcount7 + 1
tmpcount8=tmpcount8 + 1
tmpcount9=tmpcount9 + 1
tmpcount10=tmpcount10 + 1
tmpcount11=tmpcount11 + 1
tmpcount12=tmpcount12 + 1
tmpcount13=tmpcount13 + 1
tmpcount14=tmpcount14 + 1
tmpcount15=tmpcount15 + 1
tmpcount16=tmpcount16 + 1
tmpcount17=tmpcount17 + 1
tmpcount18=tmpcount18 + 1
tmpcount19=tmpcount19 + 1
tmpcount20=tmpcount20 + 1
tmpcount21=tmpcount21 + 1
Loop
Next
Close datafileNum%
Exit Sub
答案 0 :(得分:1)
创建HTML表格,但将文件扩展名设置为.xls。 我在这里写了博客:http://blog.texasswede.com/export-from-notes-to-excel-3-different-ways/ 在这里:http://blog.texasswede.com/generate-excel-spreadsheets-using-lotusscript/
最后,您可以使用我在博客上发布的课程: http://blog.texasswede.com/export-notes-view-to-excel-with-multi-value-fields/
以下是将视图导出为HTML以导入Excel的代码:
Dim csv As CSVData
Dim outfile As String
Set csv = New CSVData("DominoServer/YourDomain", "names.nsf", "People\By Last Name")
'*** Create HTML table and save as .xls to open in Excel
outfile = "c:\ExcelExportTest.xls"
Open outfile For Output As #1
Print #1, "<table>"
ForAll row In csv.HTMLArray()
Print #1, row
End ForAll
Print #1, "</table>"
Close #1
下面是班级本身。它还允许您将视图导出为CSV作为奖励。
%REM
Agent View Export
Created Mar 27, 2013 by Karl-Henry Martinsson
Description: Code to export a specified view as CSV.
Copyright (c) 2013 by Karl-Henry Martinsson
This code is distributed under the terms of
the Apache Licence Version 2.
See http://www.apache.org/licenses/LICENSE-2.0.txt
%END REM
Option Public
Option Declare
Class RowData
Public column List As String
Public Sub New()
End Sub
Public Sub SetColumnHeader(view As NotesView)
Dim viewcolumn As NotesViewColumn
Dim cnt As Integer
ForAll vc In view.Columns
Set viewcolumn = vc
column(CStr(cnt)) = viewcolumn.Title
cnt = cnt + 1
End Forall
End Sub
Public Sub SetColumnValues(values As Variant)
Dim cnt As Integer
Dim tmp As String
ForAll v In values
If IsArray(v) Then
ForAll c In v
tmp = tmp + c + Chr$(13)
End ForAll
column(CStr(cnt)) = Left$(tmp,Len(tmp)-1)
Else
column(CStr(cnt)) = v
End If
cnt = cnt + 1
End ForAll
End Sub
End Class
Class CSVData
Private row List As RowData
Private rowcnt As Long
%REM
Function New
Description: Open the view and read view data
into a list of RowData objects.
%END REM
Public Sub New(server As String, database As String, viewname As String)
Dim db As NotesDatabase
Dim view As NotesView
Dim col As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim colcnt As Integer
Set db = New NotesDatabase(server, database)
If db Is Nothing Then
MsgBox "Could not open " + database + " on " + server,16,"Error"
Exit Sub
End If
Set view = db.GetView(viewname)
If view Is Nothing Then
MsgBox "Could not access view " + viewname + ".",16,"Error"
Exit Sub
End If
Set col = view.AllEntries()
rowcnt = 0
Set entry = col.GetFirstEntry()
Set row("Header") = New RowData()
Call row("Header").SetColumnHeader(view)
Do Until entry Is Nothing
rowcnt = rowcnt + 1
Set row(CStr(rowcnt)) = New RowData()
Call row(CStr(rowcnt)).SetColumnValues(entry.ColumnValues)
Set entry = col.GetNextEntry(entry)
Loop
End Sub
%REM
Function CSVArray
Description: Returns a string array of CSV data by row
%END REM
Public Function CSVArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
textrow = textrow + |"| + Replace(h,Chr$(13),"\n") + |",|
End ForAll
rowarray(cnt) = Left$(textrow,Len(textrow)-1)
cnt = cnt + 1
End ForAll
CSVArray = rowarray
End Function
%REM
Function HTMLArray
Description: Returns a string array of HTML data by row
%END REM
Public Function HTMLArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
textrow = textrow + |<td>| + Replace(h,Chr$(13),"<br>") + |</td>|
End ForAll
rowarray(cnt) = "<tr>" + textrow + "</tr>"
cnt = cnt + 1
End ForAll
HTMLArray = rowarray
End Function
End Class