2010-10-25 272 views
1

我有一個視圖,它顯示每個文檔的9行信息。在這個視圖中,我使用下面的代碼將文檔導出到Excel中導出到Excel功能。 前兩個文檔的數據導出不正確,例如,如果第一個文檔有7行,那麼它應該導出7行,但僅導出2行。它只發生在前3個文檔中的第2個文檔,不管它輸出的信息的行號是否完美。我試圖修改從行%=行%+ 2到行%=行%+ 3,4或5的行%的代碼,但它不必在Excel表格中創建行而不是動態行,並且看起來也很奇怪。任何想法我應該怎麼做,以便行應該動態增加。導出到Excel,Lotus notes domino

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

呃,這個代碼肯定需要更可讀,我敢打賭,有一個簡單的方法,做你想做的。
好的,你能解釋一下你用什麼「CRMOpenIssue」視圖?

我建議您忘記每個文檔在視圖中代表的行數,並將文檔字段用作數據源,而不是直接在視圖列中顯示數據。

+1

我很讚賞你正在嘗試做的,但是這將是一個評論,不是答案更好。 – 2011-03-18 02:21:20

1

您上傳的代碼有些錯誤。您必須刪除或添加一個If循環,因爲在關閉它所包含的While循環之前,第一個If循環會關閉。這就是說,這應該工作,雖然我沒有測試它。

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