- Code : Tout sélectionner
'Script:
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Option Explicit
'On Error Resume Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: NotesToExcel
' FUNCTION: Retrieve the content of a Notes View in an Excel SpreadSheet
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Usage: CScript NotesToExcl pathToIniFile
'
' The example of Ini File Below
'
' [NotesToExcel]
' SERVERNAME = sppar001/srv/socgen
' DATABASEPATH = World\Survey\LAPTOPS.NSF
' ;PASSWORD = monPasswordNotes
' VIEWNAME = Answer
' WORKBOOK = C:\USERS\LAPTOPS.XLS
' VISIBLE = True
' DATAGRID = True
' Warning: The PASSWORD Option works only with Notes Release 5.X
'
Dim nView
Dim oArgs, ArgNum
Dim oFs , oXl, Fo
Dim oFields(100) , vFields(100), tFields(100), tColumns(100)
Dim fCount
Dim gServerName, gDatabasePath, gViewName, gPassword, gFields , gColumns
Dim gWorkBook, gWorkSheet, gVisible, gDataGrid
Dim gSession , gDatabase, gView
Call Main
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: Main
' FUNCTION: Main Function
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
Set oFs = CreateObject("Scripting.FileSystemObject")
Call ProcessArguments()
Call NotesInitializeAll()
Call InitExcel()
Call ProcessDocuments()
Call TerminateExcel()
Terminate( 0 )
End Sub
'
' Processing Documents
'
Sub ProcessDocuments ()
On Error Resume Next
Dim nDocument, iFields, rString
Dim nItem,nRow,nCol
WScript.Echo "Start Processing Documents"
nRow = 0
Set nDocument = Nothing
Set nDocument = gView.GetFirstDocument()
MsgBox nDocument.GetFirstItem(tFields(0))
While Not nDocument Is Nothing
Call ClearFieldsValues
rString = ""
'For Each nItem In nDocument.Items
' WScript.Echo "FIELD: " & nItem.Name
'Next
For iFields = 0 To fCount-1
Set oFields(iFields) = nDocument.GetFirstItem(tFields(iFields))
If Not oFields(iFields) Is Nothing Then
vFields(iFields) = oFields(iFields).Text
End If
Call AddExcelValue( nRow+2, iFields+1, vFields(iFields))
rString = rString & vFields(iFields) & Chr(9)
Next
WScript.Echo rString
Set nDocument = gView.GetNextDocument(nDocument)
nRow = nRow + 1
Wend
WScript.Echo "End Processing Documents"
End Sub
Function Capitalized( S )
Capitalized = UCase(Left(S,1)) & LCase(Right(S,Len(S)-1))
End Function
Function BlanktoMinus( O )
Dim I , S
S = Trim(O)
For I = 1 To Len(S)
If Right(Left(S,I),1) = " " Then
S= Left(S,I-1) & "-" & Right(S,Len(S)-I)
End If
Next
BlanktoMinus = S
End Function
Function GoodCharacters(Name)
Dim i, S,C
S = ""
For i = 0 to Len(Name) - 1
C=Right(Left(Name,i+1),1)
If C = "é" Or C = "è" Or C = "ê" Or C = "ë" Then
C = "e"
End If
If C = "ï" Or C = "î" Then
C = "i"
End If
If C = "ô" Then
C = "o"
End If
If C = "ç" Then
C = "c"
End If
If C = " " Then
C = "-"
End If
S = S & C
Next
GoodCharacters = S
End Function
Sub InitExcel()
Dim I,J
On Error Resume Next
Set oXl = WScript.GetObject("Excel.Application")
If oXl Is Nothing Then
Set oXl = WScript.CreateObject("Excel.Application")
End If
If UCase(gVisible) = "TRUE" Then
oXl.Visible = True
End If
If oFs.FileExists(gWorkBook) Then
oXl.Workbooks.Open (gWorkBook)
oXl.Sheets(1).Activate
Else
oXl.Workbooks.Add
oXl.Sheets(1).Activate
oXl.ActiveWorkbook.SaveAs (gWorkBook)
End If
If gWorkSheet <> "" Then
oXl.Sheets(gWorkSheet).Activate
oXl.Sheets(gWorkSheet).Select
End If
'oXl.ActiveSheet.Select
'oXl.ActiveSheet.Cells.Select
'oXl.ActiveWorkbook.Selection.Clear
'oXl.ActiveSheet.Selection.Clear
oXl.ActiveSheet.Clear
oXl.ActiveSheet.Rows(1).Select
oXl.ActiveWorkbook.Selection.Font.Bold = True
For I=0 To fCount - 1
oXl.ActiveSheet.Cells(1,I+1).Value = tColumns(I)
oXl.ActiveSheet.Columns(I+1).EntireColumn.AutoFit
Next
oXl.ActiveSheet.Range("A1").Select
End Sub
Sub TerminateExcel()
On Error Resume Next
oXl.ActiveSheet.Rows(1).Select
oXl.ActiveWorkbook.Selection.Font.Bold = True
For I=0 To fCount - 1
oXl.ActiveSheet.Columns(I+1).Select
oXl.ActiveSheet.Columns(I+1).EntireColumn.AutoFit
Next
If gWorkSheet <> "" Then
oXl.ActiveSheet.Name = gWorkSheet
End If
oXl.ActiveSheet.Cells(1,1).Select
oXl.ActiveWorkbook.Save
oXl.ActiveWorkbook.Close
oXL.application.quit
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: NotesOpenSession
' FUNCTION: Open a Notes Session, specifying password if ID not shared
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub NotesOpenSession()
On Error Resume Next
Set gSession = Nothing
Set gSession = CreateObject("Notes.NotesSession")
If gSession Is Nothing Then
WScript.Echo "Error Opening Notes Session"
Terminate(1)
End If
If Not gPassword Is Nothing Then
If gPassword <> "" Then
Call gSession.Initialize( pPassword )
End If
End If
End Sub
Sub NotesOpenDatabase()
On Error Resume Next
WScript.Echo "Opening Database " & gDatabasePath & " on " & gServerName
Set gDatabase = Nothing
Set gDatabase = gSession.GetDatabase( gServerName, gDatabasePath )
If gDatabase is Nothing Then
WScript.Echo "Error opening Database " & gDatabasePath & " on " & gServerName
Terminate(1)
End If
End Sub
Sub NotesOpenView()
On Error Resume Next
WScript.Echo "Opening View " & gViewName
Set gView = Nothing
Set gView = gDatabase.GetView( gViewName )
If gView is Nothing Then
WScript.Echo "Error: open View" & gViewName
Terminate(1)
End If
End Sub
Sub NotesInitializeAll
On Error Resume Next
Dim nSession , nDatabase , nView
WScript.Echo gServername & " " & gDatabasePath
Call NotesOpenSession()
Call NotesOpenDatabase ()
Call NotesOpenView ( )
End Sub
Sub Terminate( pCode )
On Error Resume Next
Set nView = Nothing
Set nDatabase = Nothing
Set nSession = Nothing
WScript.Quit( pCode )
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: ProcessArguments
' FUNCTION: Retrieve all necessary information to process
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ProcessArguments
Dim oArgs
Dim iniFilePath
Set oArgs = WScript.Arguments
If oArgs.Count <> 1 Then
WScript.Echo "Usage: CScript NotesToExcel.vbs pathToIniFile"
Terminate(1)
End If
iniFilePath = oArgs.Item(0)
Call GetPrivateProfileString("NotesToExcel","SERVERNAME" ,"",gServerName ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","DATABASEPATH","",gDatabasePath,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","VIEWNAME" ,"",gViewName ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","PASSWORD" ,"",gPassword ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","FIELDS" ,"",gFields ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","COLUMNS" ,"",gColumns ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","WORKBOOK" ,"",gWorkBook ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","WORKSHEET" ,"",gWorkSheet ,0,iniFilePath)
Call GetPrivateProfileString("NotesToExcel","VISIBLE" ,"",gVisible ,0,iniFilePath)
'If gFields = "" Then
' WScript.Echo "ERROR: FIELDS could not be an empty string"
' Terminate(1)
'End If
If gColumns = "" Then
gColumns = gFields
End If
If gWorkBook = "" Then
WScript.Echo "ERROR: FILEPATH could not be an empty string"
Terminate(1)
End If
fCount = ProcessList( tFields , gFields , ",")
fCount = ProcessList( tColumns , gColumns , ",")
WScript.Echo "Number of Fields: " & CStr(fCount)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: GetPrivateProfileString
' FUNCTION: Get a value from an INI fie, same Syntax as Win32 function
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetPrivateProfileString( lpAppName , lpKeyName , lpDefault , lpReturnedString , nSize , lpFileName )
Dim Fi, S, nSection , nKeyName
On Error Resume Next
nSection = ""
GetPrivateProfileString = 0
If Not lpDefault Is Nothing Then
lpReturnedString = lpDefault
End If
Set Fi = oFs.OpenTextFile( lpFileName, ForReading, True)
While Fi.AtEndOfStream <> True
S = Trim(Fi.ReadLine)
If ( S <> "" ) And ( Left(S,1) <> ";" ) Then
If Left(S,1) = "[" Then ' Start New Section
nSection = Trim(Split(Split(S,"[",-1,1)(1),"]",-1,1)(0))
'WScript.Echo "SECTION = " & nSection
Else
nKeyName = Trim(Split(S,"=",-1,1)(0))
If ( nSection = lpAppName ) And ( nKeyName = lpKeyName ) Then
lpReturnedString = Trim(Split(S,"=",-1,1)(1))
GetPrivateProfileString = Len(lpReturnedString)
WScript.Echo lpKeyName & "=" & lpReturnedString
Exit Function
End If
End If
End If
Wend
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: ProcessList
' FUNCTION: Split a separated string in a table, returning count of elements
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ProcessList( tElements ,lElements ,pSeparator )
Dim I, flds
flds = Split(lElements, pSeparator, -1, 1)
For I=0 To UBound(flds)
tElements(I) = flds(I)
Next
ProcessList = UBound(flds) + 1
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NAME: ClearFieldsValues
' FUNCTION: Clear Fields Values to avoid side-effect of "On Error" Statement
' CREATED: 05/12/2002
' AUTHOR: Alain Aucordier
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ClearFieldsValues
Dim I
For I=0 To fCount - 1
vFields(I) = ""
Next
End Sub
Sub AddExcelValue(nRow,nCol,tValue)
oXl.ActiveSheet.Cells(nRow,nCol).Value = tValue
End Sub
Dans un fichier .ini
[NotesToExcel]
SERVERNAME = XXX/XXX/XXX
DATABASEPATH = applis/xxx.nsf
;PASSWORD = monPasswordNotes
VIEWNAME = nomdelavue
WORKBOOK = U:\temp\EXPORT_EXCEL.XLS
VISIBLE = True
DATAGRID = True
FIELDS = Nomdeschamps,nom,prenom.....
et pour ceux qui souhaite le lancer en commande
cscript.exe xxxx.vbs xxxx.ini
