Hab da was gefunden, bekomme aber nur fehler angezeigt.
Create a View Action button with the following code in it:
@Environment("NameOfView";@Subset(@ViewTitle;1));
@Command([ToolsRunMacro];"(Export to Excel)")
Create a shared agent that is set to run manually from the agent list and set to run once (@commands may be used).
Place this code in the agent's "Options" section...
Option Public
Option Explicit
Use "ProgressBar"
Place this code in the agent's "Declarations" section:
'WIN32
Declare Function W32_NEMGetFile Lib "nnotesws" Alias "NEMGetFile" ( wUnk As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String ) As Integer
'WIN16
Declare Function W16_NEMGetFile Lib "_nem" Alias "NEMGetFile" ( wUnk As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String ) As Integer
'use nnotesws for Win95 and WinNT, and _nem for Win16
Place this code in the agent's "Initialize" event:
Sub Initialize
%REM
*************************************************
EXPORT TO EXCEL...
> This agent will export the values displayed in a view based on the documents contained in that view to an Excel spreadsheet.
> The actual export to Excel is based on the "ColumnValues" property of the NotesDocument class.
> The agent displays a Windows "File" dialog box to allow the user to select the Excel spreadsheet.
If the spreadsheet does not exist, then the "On Error 213 Resume Next" will capture the error and execute the next statement.
The next statement checks the current error number (Err) and if it exists and is equal to "213" then it will Add a new workbook to
the location specified.
> This agent also displays a progress bar to show the user the progress of the export.
The code for the progress bar should be kept in a Script Library in the Declarations section.
> To find more information on how to program for Excel using OLE, find the file named "vbaxl8.hlp.?
It should be located in the Microsoft Office directory on your hard drive.
This code has been tested and verified to work on Windows NT sp6 using Lotus Notes 4.5.5 and Lotus Notes 4.6.7
-----------------------------------------------------------------
Mathew Kline - 07/27/2001
*************************************************
%END REM
On Error Goto generalerrorhandler
On Error 213 Resume Next
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim viewname As String
Dim doc As NotesDocument
Dim column As NotesViewColumn
Dim nbcol As Integer
Dim i As Long
Dim j As Integer
Dim k As Integer
'File Dialog
Dim strFileName As String*256
Dim strTitle$
Dim strFilter$
'Excel Application
Dim Handle As Variant
Dim WBook As Variant
Dim Wsheet As Variant
Set db = session.CurrentDatabase
viewname = session.GetEnvironmentString("NameOfView")
Set view = db.GetView(viewname)
'File Dialog
strFileName = Chr(0)
strTitle$ = "Select Excel file to export to."
strFilter$ = "MS Excel Files|*.xls|All Files|*.*|" 'Use this format for ANY file type
If IsDefined ("WIN32") Then
If W32_NEMGetFile (0, strFileName, strFilter$, strTitle$) <> 0 Then
strFileName = strFileName & |"| 'We need to do this because the return is a NULL terminated string.
Else 'The user chose to Cancel the operation so exit the subroutine
Exit Sub
End If
Elseif IsDefined ("WIN16") Then
If W16_NEMGetFile (0, strFileName, strFilter$, strTitle$) <> 0 Then
strFileName = strFileName & |"|
Else 'The user chose to Cancel the operation so exit the subroutine
Exit Sub
End If
Else
Msgbox "Cannot load file dialog window on this operating system." & Chr(13) & "Process Terminated",0+64,"Error"
Exit Sub
End If
'Open Excel Application
Set Handle = CreateObject("Excel.Application")
Set WBook = Handle.Workbooks.Open(strFileName)
If Err = 213 Then
Set WBook = Handle.Workbooks.Add
Else
If Msgbox ("The export to Excel is about to begin. All existing spreadsheet contents will be overwritten!" & Chr(13) & Chr(13) & "Do you wish to proceed?",4+48,"Export to Excel") = 7 Then
WBook.Close
Handle.DisplayAlerts = True
Handle.Quit
Set Handle = Nothing
Exit Sub
End If
End If
'Handle.Visible = True 'Uncomment if you wish Excel to be seen
Set Wsheet = WBook.Application.Workbooks(1).Worksheets(1)
Handle.DisplayAlerts = False
'Clear contents of worksheet - Method 1...
'Delete and then re-add the worksheet itself
'Wsheet.Delete
'WBook.Worksheets.Add
'Set Wsheet = WBook.Application.Workbooks(1).Worksheets(1)
'Clear contents of worksheet - Method 2...
'By not specifying a range for the Cells property, all the contents in all the cells on the worksheet will be erased
Wsheet.Cells.ClearContents
nbcol = Ubound(view.Columns) 'Determine the number of columns in the view
'Progress Bar
Dim doc2 As NotesDocument
Dim p As Long
'Create a count of all the documents in this view. This will be used to set the upper bound for the Progress Bar
Set doc2 = view.GetFirstDocument
p = 0
While Not (doc2 Is Nothing)
p = p + 1
Set doc2 = view.GetNextDocument(doc2)
Wend
Dim pb As New LNProgressBar(True)
Call pb.SetText("Exporting View to Excel Spreadsheet." & Chr(13) & Chr(13),"Please wait...")
'We set the range of the Progress Bar to p elements
Call pb.SetProgressRange(p)
'Begin looping through the documents in the view and add them into the Excel worksheet starting on row 3. Change the variable "i" to start on a different row.
'Remember that the column headings will occupy row one.
i = 3
k = 0
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
Call pb.SetProgressPos(i - 3)
For k = 0 To nbcol 'Populate additional rows and columns in Excel spreadsheet from Notes documents in view
Wsheet.Cells(i,k + 1).Value = doc.ColumnValues(k)
Next
i = i + 1
Set doc = view.GetNextDocument(doc)
Wend
'Create column headings in Excel spreadsheet
j = 0
Do
Set column = view.Columns(j)
Wsheet.Cells(1, j + 1).Value = column.Title
j = j + 1
Loop Until j = nbcol + 1
'Perform formatting in the Excel spreadsheet
Wsheet.Rows(1).Font.Bold = True
Wsheet.Rows(1).Font.Size = 12
Wsheet.Columns(7).NumberFormat = "################" 'Formats the seventh column to display the account numbers properly. Comment out or modify for your specific needs.
'Other number formats can include: "$#,##0.00" or "hh:mm:ss". See the "Vbaxl8.hlp" help file for more information.
For k = 1 To nbcol + 1
Wsheet.Columns(k).Autofit
Next
'Terminate the progress bar
Call pb.PBDelete
'Close Excel application
Handle.ActiveWorkbook.SaveAs strFileName
Handle.ActiveWorkbook.Close
Handle.DisplayAlerts = True
Handle.Quit
Set Wsheet=Nothing
Set Wbook=Nothing
Set Handle=Nothing
Msgbox "Export to Excel completed successfully.",0+64,"Export Complete"
Exit Sub
generalerrorhandler:
Msgbox "Error " & Err() & ": " & Error(),0+64,"Error"
If Not (pb Is Nothing) Then
Call pb.PBDelete
End If
WBook.Close
Handle.DisplayAlerts = True
Handle.Quit
Set Handle = Nothing
Exit Sub
End Sub
Create a Script Library and place this code in the "Declarations" section (Whatever you name the Script Library, make sure it is the same in the "Use" statement in the "Options" section of the agent)...
Declare Public Function NEMProgressBegin Lib "nnotesws.dll" ( Byval wFlags As Integer ) As Long
Declare Public Sub NEMProgressDeltaPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwIncrement As Long )
Declare Public Sub NEMProgressEnd Lib "nnotesws.dll" ( Byval hwnd As Long )
Declare Public Sub NEMProgressSetBarPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwPos As Long)
Declare Public Sub NEMProgressSetBarRange Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwMax As Long )
Declare Public Sub NEMProgressSetText Lib "nnotesws.dll" ( Byval hwnd As Long, Byval pcszLine1 As String, Byval pcszLine2 As String )
Const NPB_TWOLINE = 3
Const NPB_ONELINE = 2
Public Class LNProgressbar
hwnd As Long
Sub New(SecondLineVisible As Integer)
'Set-up the progress bar on the screen
If SecondLineVisible Then
hwnd = NEMProgressBegin(NPB_TWOLINE)
Else
hwnd = NEMProgressBegin(NPB_ONELINE)
End If
End Sub
Sub SetText(FirstLineText As String,SecondLineText As String)
'Display the text in progress bar
NemProgressSetText hwnd, FirstLineTExt,SecondLineText
End Sub
Sub SetProgressPos(Progresspos As Long)
NEMProgressSetBarPos hwnd, ProgressPos
End Sub
Sub SetProgressRange(ProgressMaxElements As Long)
'Set-up the max elements in the progress bar, if you have
'a list with 230 elements then set the MAX to 230 elements.
'For every element you proceed increase the SetProgressPos
'by one to reached 230
NEMProgressSetBarRange hwnd, ProgressMaxElements
End Sub
Sub DeltaPos(DPos As Long)
' This function adds the number in DPOS to the current ProgressPos
NEMProgressDeltaPos hwnd, DPos
End Sub
Sub PBDelete
'Terminate the progress bar on the screen
NEMProgressEnd hwnd
End Sub
End Class
