回到臭氧窩

Date: 07/19/2002 07:42:51 PM
Name: chen_ys
Email: chen_ys@seed.net.tw
Subject: 第一期:匯出任意NOTES的視界資料至EXCEL檔
Categories: 一般問題
Website: None
返回討論版區
智頡科技分享報第一期

Export any view to Excel(匯出任意NOTES的視界資料至EXCEL檔)
Sub Initialize

Dim Session As New NotesSession ,db As NotesDatabase
Dim sourceview As NotesView,sourcedoc As NotesDocument
Dim dataview As NotesView, dc As NotesDocumentCollection
Dim datadoc As NotesDocument, maxcols As Integer
Dim WS As New Notesuiworkspace
Dim ViewString As String, Scope As String, GetField As Variant
Dim C As NotesViewColumn, FieldName As String, K As Integer,N As Integer
Dim xlApp As Variant, xlsheet As Variant, rows As Integer, cols As Integer
Dim nitem As NotesItem , entry As NotesViewEntry, vwNav As NotesViewNavigator
Dim ShowView() As Variant, i As Integer, VList As Variant, ColVals As Variant

Set db = session.CurrentDatabase 'link to current database

'fetch then display a list of views in the database
Vlist= db.views
K=Ubound(Vlist) 'get size of list
Redim Preserve ShowView(K)
N=-1
For i = 0 To K
If Len(Vlist(i).Name) >0 Then
FieldName=Trim(Vlist(i).Name)
If Mid(Fieldname,1,1) <>"(" Then 'do not show hidden views
N=N+1
ShowView(N) = FieldName
End If
End If
Next i


Redim Preserve ShowView(N)
'now sort the list - by default views are listing in the order that they were created
For i=0 To N
For K=i To N
If ShowView(i) > ShowView(k) Then
FieldName=ShowView(i)
ShowView(i) = ShowView(k)
ShowView(k)=FieldName
End If
Next k
Next i

viewstring= ws.Prompt(PROMPT_OKCANCELLIST,"List of Views","Choose a View","",ShowView )

If Len(viewstring)=0 Then Exit Sub
'ViewString ="Dan's View"

Set dataview = db.getview(ViewString) 'get selected view

Set vwnav= dataview.createViewnav()

rows = 1
cols = 1
maxcols=dataview.ColumnCount 'how many columns?

Set xlApp = CreateObject("Excel.Application") 'start Excel with OLE Automation
xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.ReferenceStyle = 2
Set xlsheet = xlApp.Workbooks(1).Worksheets(1) 'select first worksheet

'worksheet title
xlsheet.Cells(rows,cols).Value =
"View: " + ViewString + ", from Database: " + db.title +", Extract created on: " + Format(Now,"mm/dd/yyyy HH:MM")

xlApp.StatusBar = "Creating Column Heading. Please be patient..."

rows=2 'column headings starts in row 2
For K=1 To maxcols
Set c=dataview.columns(K-1)
xlsheet.Cells(rows,cols).Value = c.title
cols = cols + 1
Next K

Set entry=vwnav.GetFirstDocument
rows=3 'data starts in third row
Do While Not (entry Is Nothing)

For cols=1 To maxcols
colvals=entry.ColumnValues(cols-1) 'subscript =0
scope=Typename(colvals)
Select Case scope
Case "STRING"
xlsheet.Cells(rows,cols).Value ="'" + colvals
Case Else
xlsheet.Cells(rows,cols).Value = colvals
End Select
Next cols
xlApp.StatusBar = "Importing Notes Data - Document " & rows-1 '& " of " & dc.count & "."
rows=rows+1
Set entry = vwnav.getnextdocument(entry)
Loop

xlApp.Rows("1:1").Select
xlApp.Selection.Font.Bold = True
xlApp.Selection.Font.Underline = True
xlApp.Range(xlsheet.Cells(2,1), xlsheet.Cells(rows,maxcols)).Select
xlApp.Selection.Font.Name = "Arial"
xlApp.Selection.Font.Size = 9
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."
'xlapp.ActiveWorkbook.saveas "c:VX" + Trim(Format(Now,"yyy")) 'save with generated name
dataview.clear

Set xlapp=Nothing 'stop OLE
Set db=Nothing

End Sub


主 題 發表人 發表日期
Lotus Notes Tips等資訊之電子報 Anonymous07/19/2002 07:32:08 PM
  第一期:匯出任意NOTES的視界資料至EXCEL檔 chen_ys07/19/2002 07:42:51 PM
    Re:感謝您的分享(無內容勿進) Snail07/20/2002 07:36:53 AM
    Re: 有點問題,請想教 algo07/22/2002 07:54:04 AM
      Re: Re: 有點問題,請想教 Luke07/26/2002 08:58:14 AM
  Re: Lotus Notes Tips等資訊之電子報 Jason07/22/2002 08:25:54 AM
    Re: Re: Lotus Notes Tips等資訊之電子報 AnonymousA-Ping07/22/2002 08:38:14 AM
      Re: Re: Re: Lotus Notes Tips等資訊之電子報 chaos07/22/2002 09:03:54 AM
        Re: Re: Re: Re: Lotus Notes Tips等資訊之電子報 shing07/22/2002 09:38:16 AM
          Re: Re: Re: Re: Re: Lotus Notes Tips等資訊之電子報 chaos07/23/2002 07:26:11 AM
            To : Chaos shing07/23/2002 10:58:13 AM