Otro agente del año 2000
que tiempos aquellos
Sub Initialize
'***********************************************************************************************************************************************************
' ***************** Juan Carlos Trigo Diaz - http://Roccosworld.redireccion.com ***********************************************************
' ***************** SkillSoft 28/12/00 *************************************************************************************************************
' ***************** Script para exportar datos de los documentos seleccionados a un documento de Excel ******************************
' ***************** Pide unidad de disco, path y nombre del fichero que queremos crear ****************************************************
' ***************** Comprueba que la unidad de disco existe y el directorio, en caso contraio lo crea *************************************
' ***************** Añade a excel los valores de los campos urlcategories, urldescrip, url, fecha ******************************************
' ***************** Muestra el número total de registros introducidos ****************************************************************************
' ***************** Guarda el fichero en la ruta que le habiamos dado y con el nombre del fichero que habíamos introducido **********
'*************************************************************************************************************************************************************
On Error Goto Fallos
' ***************** Declaración de Variables *****************
Dim ns As New notessession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim ndcol As notesdocumentcollection
Dim row As Integer
Dim escritos As Integer
Dim xlFilename As String
Dim Excel As Variant
Dim xlWorkbook As Variant
Dim xlSheet As Variant
' ***************** Etiquetas de errores
peticionunidad: ' Etiqueta para que vuelva el script a esta linea cuando el usuario mete más de una letra o ninguna como unidad de disco
unidad=Inputbox$( "Escribe la unidad del disco" , "Introduce la Unidad de Disco. Ejemplo C" , "C" )
longitud=Len(unidad)
'comprobamos la longitud del texto introducido como unidad de disco
If longitud=0 Or longitud>1 Then
opcion=Msgbox ("Introduce solo una letra",1,"Error")
If opcion=2 Then
Exit Sub
End If
Goto peticionunidad
End If
unidad2=Left$(unidad,1)+":"
disco=unidad2
'Peticion del path(ruta)
directorio=Inputbox$( "Escribe la ruta" , "Introduce la ruta Ejemplo: videos o videos/humor" , "" )
longituddir=Len(directorio)
inicio=Left$(directorio,1)
Dim final As Integer
final=longituddir-1
fin=Right$(directorio,1)
'comprobamos que el path sea de tipo \nombredirectorio\....
barrainicio=Strcompare("\", inicio, 1)
barrafin=Strcompare("\", fin, 1)
If barrainicio=0 And barrafin=0 Then
pathName$=disco+directorio
Elseif barrainicio><0 And barrafin=0 Then
pathName$=disco+"\"+directorio
Elseif barrainicio=0 And barrafin><0 Then
pathName$=disco+directorio+"\"
Elseif barrainicio<>0 And barrafin>0 Then
pathName$=disco+"\"+directorio+"\"
End If
etiqueta$="1"
xlFilename=Inputbox$( "Escribe el nombre del fichero" , "Escribe el nombre del fichero" , "" )
Set db = ns.CurrentDatabase
Set ndcol=db.unprocesseddocuments
Print "Connectando a Excel..."
Set Excel = CreateObject( "Excel.Application" )
Excel.Visible =False '// No mostramos la ventana de Excel
Print "Opening " & xlFilename & "..."
Excel.Workbooks.Add 'Creamos un Libro Nuevo
Set xlWorkbook = Excel.ActiveWorkbook
Set xlSheet = xlWorkbook.ActiveSheet
Goto inicializar
Print "Desconectando de Excel..."
xlWorkbook.Close False '// Cerramos la hoja de Excel sin guardar cambios
Excel.Quit ' Cerramos Excel
Set Excel = Nothing 'Liberamos la memoria que hemos utilizado
Print " " ' Limpiamos la linea de stado
inicializar:
row = 0 'Inicializamos las columnas a 0
written = 0
Print "Comenzando la Exportación del Fichero Excel ..."
Set nd=ndcol.getfirstdocument
Do While True
Datos:
With xlSheet
For i=1 To ndcol.count
row = row + 1
.Cells( row, 1 ).Value=nd.urlcategories
.Cells(row, 2 ).Value=nd.urldescrip
.Cells(row, 3).Value=nd.url
.Cells(row,4).Value=nd.fecha
escritos = escritos + 1
If escritos = ndcol.count Then
Goto Completo
End If
Set nd=ndcol.getnextdocument(nd)
Next
End With
Loop
Return
Completo:
'cambiamos de unidad y path
Chdrive unidad
ruta=pathName$
etiqueta$="2"
'Guardamos el fichero en la ruta elegida y con el nombre introducido
xlWorkBook.SaveAs ruta+xlFilename+".xls"
xlWorkbook.Close True 'Cerramos la hoja de Excel y Guardamos
Excel.Quit '// Cerramos Excel
Msgbox "Registros Creados:" &Cstr(ndcol.count)
Exit Sub
Fallos:
Select Case etiqueta$
Case"1"
'si no existe la unidad de disco salimos de la rutina
Msgbox "No existe la unidad de Disco","0","Vuelve a ejecutarlo"
Exit Sub
Case "2"
' Si no existe el directorio lo crea
Mkdir ruta
Goto Completo
End Select
End Sub
|
Otros documentos de LotusScript
|