我有一个视图,每个文档显示9行信息。在此视图中,我使用以下代码导出到Excel功能,以将文档导出到Excel。 前两个文档的数据输出不正确,例如,如果第一个文档有7行,那么它应该导出7行,但只导出2行。它只发生在前2个文件中,从第3个文件开始,无论它输出的任何信息号码都是完美的。我试图将行%的代码从行%=行%+ 2修改为行%=行%+ 3,4或5,但是它在excel表中不必要的创建行而不是动态行,看起来也很奇怪。任何想法我应该做什么,以便行应该动态增加。
Sub Initialize
'On Error Goto errhandler
On Error Resume Next
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doccoll As NotesDocumentCollection
Dim view As NotesView
Dim doc As NotesDocument
Dim otherdoc As NotesDocument
Set db = session.CurrentDatabase
Set view = db.GetView("CRMOpenIssue")
Set doccoll=db.UnprocessedDocuments
Set oExcel = CreateObject ( "Excel.Application" )
Set oWorkbook = oExcel.Workbooks.Add
Set oWorkSheet= oWorkbook.Sheets ( 1 )
oWorkSheet.Cells(1,1).value="Quote# "
oWorkSheet.Cells(1,2).value="Quote Line#"
oWorkSheet.Cells(1,3).value="Customer - fab"
oWorkSheet.Cells(1,4).value="OppNum"
oWorkSheet.Cells(1,5).value="OppLine#"
oWorkSheet.Cells(1,6).value="Open Issue#"
oWorkSheet.Cells(1,7).value="Open Issue"
oWorkSheet.Cells(1,8).value="Category"
oWorkSheet.Cells(1,9).value="Due date"
oWorkSheet.Cells(1,10).value="Owner to resolve issue"
oWorkSheet.Cells(1,11).value="Owner/PME Verify when closed"
oExcel.Worksheets(1).Range("A1:K1").Font.Bold = True
oExcel.columns("A:A").ColumnWidth=15.00
oExcel.columns("B:B").ColumnWidth=8.00
oExcel.columns("C:C").ColumnWidth=15.00
oExcel.columns("D:D").ColumnWidth=10.00
oExcel.columns("E:E").ColumnWidth=8.00
oExcel.columns("F:F").ColumnWidth=8.00
oExcel.columns("G:G").ColumnWidth=30.00
oExcel.columns("H:H").ColumnWidth=30.00
oExcel.columns("I:I").ColumnWidth=15.00
oExcel.columns("J:J").ColumnWidth=15.00
oExcel.columns("K:K").ColumnWidth=30.00
row% = 1
offset% = 0
lastOffset% = 0
If doccoll.count >1 Then 'if more than one doc selected then confirm
resp = Messagebox("Do you want to export only the " & _
"selected " & doccoll.count & " documents?", 36, "Selected only?" )
Else
Messagebox "Exporting all rows. (To export only selected " & _
"rows tick those required in the left margin first.)"
End If '6= yes
oExcel.visible=True
If resp=6 Then 'selected documents
Set doc = doccoll.GetFirstDocument
While Not doc Is Nothing
If resp=6 Then
row% = row%+2
col% = 0 'Reset the Columns
Set otherdoc = view.getnextdocument(doc)
If otherdoc Is Nothing Then
Set otherdoc = view.getprevdocument(doc)
If otherdoc Is Nothing Then
Print " >1 doc should be selected"
End
Else
Set otherdoc = view.getnextdocument(otherdoc)
End If
Else 'got next doc
Set otherdoc = view.getprevdocument(otherdoc)
End If
End If
Forall colval In otherdoc.ColumnValues
col% = col% + 1
If Isarray(colval) Then
columnVal=Fulltrim(colval)
For y = 0 To Ubound(columnVal)
offset% = row% + y +lastOffset%
oWorkSheet.Cells(offset%,col%).value = columnVal(y)
Next
Else
oWorkSheet.Cells(row%, col%).value = colval
End If
End Forall
Set doc = doccoll.GetNextDocument(doc)
Wend
Else 'all documents
Set otherdoc =view.GetFirstDocument
While Not otherdoc Is Nothing
row% = row% + 2
col% = 0 'Reset the Columns
'Loop through all the column entries
'Forall colval In entry.ColumnValues
Forall colval In otherdoc.ColumnValues
col% = col% + 1
If Isarray(colval) Then
columnVal=Fulltrim(colval)
For y = 0 To Ubound(columnVal)
offset% = row% + y +lastOffset%
oWorkSheet.Cells(offset%,col%).value = columnVal(y)
Next
Else
oWorkSheet.Cells(row%, col%).value = colval
End If
End Forall
row%=offset%
Set otherdoc=view.GetNextDocument(otherdoc)
Wend
End If
'errhandler:
Call oExcel.quit()
Set oWorkSheet= Nothing
Set oWorkbook = Nothing
Set oExcel = Nothing
Print "Done"
End Sub
答案 0 :(得分:1)
我看到你正在使用Excel自动化。 Excel自动化有时很麻烦。
我会尝试NPOI for Excel XLS文件。看看吧。真的很容易合作:
答案 1 :(得分:1)
您上传的代码存在一些问题。您必须已删除或添加If循环,因为第一个If循环在关闭它包含的While循环之前关闭。话虽如此,这应该有用,虽然我还没有测试过。
Option Public
Option Declare
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doccoll As NotesDocumentCollection
Dim view As NotesView
Dim doc As NotesDocument
Dim resp As Integer, row As Integer, offset As Integer, nextrow As Integer, col As Integer
Dim oExcel As Variant
Dim oWorkbook As Variant
Dim oWorkSheet As Variant
On Error GoTo olecleanup
Set db = session.CurrentDatabase
Set view = db.GetView("CRMOpenIssue")
Set doccoll=db.UnprocessedDocuments
Set oExcel = CreateObject ( "Excel.Application" )
Set oWorkbook = oExcel.Workbooks.Add
Set oWorkSheet = oWorkbook.Sheets ( 1 )
oWorkSheet.Cells(1,1).value="Quote# "
oWorkSheet.Cells(1,2).value="Quote Line#"
oWorkSheet.Cells(1,3).value="Customer - fab"
oWorkSheet.Cells(1,4).value="OppNum"
oWorkSheet.Cells(1,5).value="OppLine#"
oWorkSheet.Cells(1,6).value="Open Issue#"
oWorkSheet.Cells(1,7).value="Open Issue"
oWorkSheet.Cells(1,8).value="Category"
oWorkSheet.Cells(1,9).value="Due date"
oWorkSheet.Cells(1,10).value="Owner to resolve issue"
oWorkSheet.Cells(1,11).value="Owner/PME Verify when closed"
oExcel.Worksheets(1).Range("A1:K1").Font.Bold = True
oExcel.columns("A:A").ColumnWidth=15.00
oExcel.columns("B:B").ColumnWidth=8.00
oExcel.columns("C:C").ColumnWidth=15.00
oExcel.columns("D:D").ColumnWidth=10.00
oExcel.columns("E:E").ColumnWidth=8.00
oExcel.columns("F:F").ColumnWidth=8.00
oExcel.columns("G:G").ColumnWidth=30.00
oExcel.columns("H:H").ColumnWidth=30.00
oExcel.columns("I:I").ColumnWidth=15.00
oExcel.columns("J:J").ColumnWidth=15.00
oExcel.columns("K:K").ColumnWidth=30.00
offset% = 0
nextrow% = 3
If doccoll.count >1 Then 'if more than one doc selected then confirm
resp = MessageBox("Do you want to export only the " & _
"selected " & doccoll.count & " documents?", 36, "Selected only?" )
Else
MessageBox "Exporting all rows. (To export only selected " & _
"rows tick those required in the left margin first.)"
End If '6= yes
oExcel.visible=True
If resp=6 Then 'selected documents
Set doc = doccoll.GetFirstDocument
If doccoll.count = 1 Then
Print " >1 doc should be selected"
End If
Else
Set doc =view.GetFirstDocument
End if
While Not doc Is Nothing
row% = nextrow%
col% = 0 'Reset the Columns
nextrow% = row% + 1
ForAll colval In doc.ColumnValues
col% = col% + 1
If IsArray(colval) Then
offset% = row%
ForAll cv In colval
If CStr(cv) <> "" Then
oWorkSheet.Cells(offset%,col%).value = cv
offset% = offset% + 1
End If
End ForAll
If nextrow% < offset% Then nextrow% = offset%
Else
oWorkSheet.Cells(row%, col%).value = colval
End If
End ForAll
If resp=6 Then 'selected documents
Set doc = doccoll.Getnextdocument(doc)
Else
Set doc =view.Getnextdocument(doc)
End If
Wend
oExcel.activeworkbook.close
oExcel.quit
Set oExcel = Nothing
Finish :
Print "Done"
Exit Sub
olecleanup :
' Call LogError() 'Enable to use OpenLog
If Not(IsEmpty(oExcel)) Then
oExcel.activeworkbook.close
oExcel.quit
Set oExcel = Nothing
End If
Resume Finish
End Sub
答案 2 :(得分:0)
呃,这个代码肯定需要更具可读性,我敢打赌,有一种更简单的方法可以做你想要的。
好的,您能解释一下您使用“CRMOpenIssue”视图的内容吗?
我建议您忘记视图中每个文档所代表的行数,并使用文档字段作为数据源,而不是直接在视图列中显示的数据。