Código: Seleccionar todo
REM ***** BASIC *****
Sub Main
Dim sTest as String
sys = CreateUnoService("com.sun.star.system.SystemShellExecute")
sTest = "c:\fichas\222.odt"
sys.execute( sTest, "", 0)
End Sub
Código: Seleccionar todo
REM ***** BASIC *****
Sub Main
Dim sTest as String
sys = CreateUnoService("com.sun.star.system.SystemShellExecute")
sTest = "c:\fichas\222.odt"
sys.execute( sTest, "", 0)
End Sub
Código: Seleccionar todo
Sub Texto (Event)
Dim mArg()
oForm= Event.Source.Model.Parent
oText= oForm.getByName("txtDocumento").Boundfield.getString
RutaDocumento= ConvertToURL("c:\fichas\"& oText &".odt")
oDocumento = StarDesktop.loadComponentFromURL( RutaDocumento, "_blank", 0, mArg() )
End Sub
Código: Seleccionar todo
Option Explicit
Sub InsertDoc(Event As Object)
Dim oFormD As Object
Dim oDialFP As Object
Dim sURL As String
oFormD=Event.Source.Model.Parent
sURL = ConvertToURL(oFormD.Columns.GetByName("Documento").GetString)
If sURL <>"" Then
MsgBox "No se permite insertar URL en un registro con datos"
Exit Sub
End If
oDialFP=CreateUnoService ("com.sun.star.ui.dialogs.FilePicker")
oDialFP.Title = "Elija un documento"
If Dir(sURL)<>"" Then oDialFP.DisplayDirectory=sURL
If oDialFP.Execute Then
sURL=oDialFP.Files(0)
oFormD.Columns.GetByName("Documento").UpdateString(sURL)
End If
If oFormD.IsModified Then
If oFormD.IsNew Then oFormD.InsertRow Else oFormD.UpdateRow
End If
End Sub
Sub AbreDoc(Event As Object)
Dim oFormD As Object
Dim sURL As String
Dim sAbrir As Object
On Error Goto Err_sAbreDoc
oFormD=Event.Source.Model.Parent
sURL = ConvertToURL(oFormD.Columns.GetByName("Documento").GetString)
If Dir(sURL)="" Then
MsgBox "No se encuentra el archivo: " & sURL
Exit Sub
End If
If FileExists(sURL) Then
'abre el archivo si lo encuentra
sAbrir = CreateUnoService("com.sun.star.system.SystemShellExecute")
sAbrir.execute( sURL, "", 0)
Else
'no encuentra el archivo
MsgBox "No existe el archivo " & sURL
End If
Exit Sub
Err_sAbreDoc:
MsgBox "Error al abrir el archivo: " & sURL
On Error Goto 0
End Sub
Sub BotonAbreDocumento( Evento )
Dim sRuta As String
Dim sArchivo As String
Dim sAbrir As Object
'El control donde esta el nombre del archivo
sArchivo = Evento.Source.Model.Parent.getByName("Selector").Text
If IsNull(sArchivo) Or sArchivo = "" Then
MsgBox "Revisa que existe el archivo en el campo"
Exit Sub
End If
'Busca el archivo correspondiente
If FileExists(sArchivo) Then
'abre el archivo si lo encuentra
sAbrir = CreateUnoService("com.sun.star.system.SystemShellExecute")
sAbrir.execute( sArchivo, "", 0)
Else
'no encuentra el archivo
MsgBox "No existe el archivo " & sArchivo
End If
End Sub
Longi escribió:Buenas!
He visto que RMG ya te respondió, pero no me ha dado tiempo a leer la respuesta.
Yo he colocado en el formualrio principal tres botones:
1- el de "DOCUMENTOS" te abre la carpeta del registro que estás viendo en el formulario
2- el de "COPIAR DOCU" te manda a un buscador para que encuentres el documento y te pide que lo nombres de algún modo (un mínimo de 5 caracteres) y lo copia hacia la carpeta del registro que está a la vista en el formulario.
3 el de "IMPORTAR DOCU" hace casi lo mismo, solo que en este caso no le puse el límite de caracteres y hace desaparecer el documento de la posición original (si lo tenías en escritorio ahora solo lo tienes en la carpeta del registro del formulario. La otra macro hace una copia y deja uno en cada lado).
Supongo que con estos tres ejemplos podrás ir hilando un poco lo que quieres.
Considero que sería bueno que diese numeración automática al hacer un nuevo registro y que se generasen las carpetas así mismo de forma automática (evitamos errores), pero esto para versiones posteriores....
A ver si te convence!
Un saludo!
RMG escribió:Pues no se que ha podido pasar, en mi ejemplo también han desaparecido las macros. Estas son, en Modulo1, recuerda abre cualquier tipo de archivo.
SaludosCódigo: Seleccionar todo
Option Explicit Sub InsertDoc(Event As Object) Dim oFormD As Object Dim oDialFP As Object Dim sURL As String oFormD=Event.Source.Model.Parent sURL = ConvertToURL(oFormD.Columns.GetByName("Documento").GetString) If sURL <>"" Then MsgBox "No se permite insertar URL en un registro con datos" Exit Sub End If oDialFP=CreateUnoService ("com.sun.star.ui.dialogs.FilePicker") oDialFP.Title = "Elija un documento" If Dir(sURL)<>"" Then oDialFP.DisplayDirectory=sURL If oDialFP.Execute Then sURL=oDialFP.Files(0) oFormD.Columns.GetByName("Documento").UpdateString(sURL) End If If oFormD.IsModified Then If oFormD.IsNew Then oFormD.InsertRow Else oFormD.UpdateRow End If End Sub Sub AbreDoc(Event As Object) Dim oFormD As Object Dim sURL As String Dim sAbrir As Object On Error Goto Err_sAbreDoc oFormD=Event.Source.Model.Parent sURL = ConvertToURL(oFormD.Columns.GetByName("Documento").GetString) If Dir(sURL)="" Then MsgBox "No se encuentra el archivo: " & sURL Exit Sub End If If FileExists(sURL) Then 'abre el archivo si lo encuentra sAbrir = CreateUnoService("com.sun.star.system.SystemShellExecute") sAbrir.execute( sURL, "", 0) Else 'no encuentra el archivo MsgBox "No existe el archivo " & sURL End If Exit Sub Err_sAbreDoc: MsgBox "Error al abrir el archivo: " & sURL On Error Goto 0 End Sub Sub BotonAbreDocumento( Evento ) Dim sRuta As String Dim sArchivo As String Dim sAbrir As Object 'El control donde esta el nombre del archivo sArchivo = Evento.Source.Model.Parent.getByName("Selector").Text If IsNull(sArchivo) Or sArchivo = "" Then MsgBox "Revisa que existe el archivo en el campo" Exit Sub End If 'Busca el archivo correspondiente If FileExists(sArchivo) Then 'abre el archivo si lo encuentra sAbrir = CreateUnoService("com.sun.star.system.SystemShellExecute") sAbrir.execute( sArchivo, "", 0) Else 'no encuentra el archivo MsgBox "No existe el archivo " & sArchivo End If End Sub
Código: Seleccionar todo
Sub CopiarDoc(Evento As Object)
GlobalScope.BasicLibraries.LoadLibrary("Tools") ' Descargamos la biblioteca
'------------------------------------------------------
' Elementos con los que vamos a trabajar
oForm = Evento.Source.Model.Parent ' El formulario activo
numero= oForm.GetByName("txtID_LAB").BoundField.String ' Número del expediente
'-----------------------------------------------
' Traducimos el número hacia un texto progresivo
If len(numero)=1 Then ' Si tiene un dígito
numero= "00" & numero ' Le ponemos dos ceros
End if
If len(numero)=2 Then ' Si tiene dos dígitos
numero="0"& numero ' Le ponemos un cero delante
End if
If len(numero)=3 Then ' Si tiene tres dígitos
numero= numero ' No le ponemos nada
End if
IDReg= oForm.GetByName("fmtID_REG").Boundfield.String ' Lo que está en el formulario
FechaEnt= oForm.GetByName("datFECHA_ENTRADA").Boundfield.String ' Lo que está en el formulario
'-----------------------------------------------
' Creamos la carpeta
oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" ) ' Servicio para acceso a archivos
Carpeta=ConvertToURL(DirectoryNameoutofPath (ThisDatabasedocument.getURL(),"/",0) &"/DOCUMENTACION/"& numero)
If Not FileExists(carpeta) Then ' Si no existe
oSimpleFileAccess.createFolder(Carpeta) ' La creamos
End if ' Acabamos la condición
'-----------------------------------------------------------------------
' Iniciamos búsqueda de un documento
oDialFP=CreateUnoService ("com.sun.star.ui.dialogs.FilePicker") ' Creamos el servicio FilePicker
oDialFP.Title="Elija un documento" ' Título del cuadro de diálogo
If oDialFP.Execute Then ' Si se ejecuta el FilePicker
Nombre = InputBox("¿Con qué nombre guardamos el documento?") ' Pregunta por el nombre con el que queremos guardar el documento
'------------------------------------------------------------------
' Precisamos una longitud superior a cuatro caracteres para grabar el documento con un nombre
if len(Nombre)<5 Then ' En caso de que tenga menos de 5 caracteres
do ' Inicia un bucle
msgbox "El nombre debe tener más de cuatro caracteres, No se guardará nada" ' Nos avisa de que no lo guardará
RespuestaLongitud=1 ' Variable arbitraria
Nombre = InputBox("¿Con qué nombre guardamos el documento?") ' Pregunta por el nombre con el que queremos guardar el documento
if len(Nombre)<5 Then ' Si la longitid del nuevo nombre sigue siendo menor de 5 caracteres
RespuestaLongitud=1 ' La variable sigue siendo 1
Else ' En caso de que tenga más caracteres
RespuestaLongitud=2 ' Cambiamos el valor de la variable a 2
End if ' Acabamos la condición de que tenga menos de cinco caracteres
Loop While RespuestaLongitud = 1 ' Hace el bucle mientras la variable no cambie de valor
End if ' Acabamos la primera condición de que tenga menos de cinco caracteres
'------------------------------------------------------------------
' Si conseguimos que el nombre tenga más de 4 caracteres (5 ó más)
if len(Nombre)>4 then ' Si tiene más de 4 caracteres
NombreDocumento= Nombre & "." & Right (oDialFP.Files(0),3) ' Nombre completo que tendrá el documento
RutaDocumento = ConvertToURL(DirectoryNameoutofPath (ThisDatabasedocument.getURL(),"/",0) &"/DOCUMENTACION/"& numero &"/" & NombreDocumento)' Ruta del documento
Documento=ConvertFromURL(oDialFP.Files(0)) ' Convertimos la ruta a URL
'------------------------------------------------------
' Control de existencia del documento
If FileExists(RutaDocumento) Then ' Si el documento existe
Respuesta=msgbox ("El documento ya existe" & Chr(13) & "¿quiere sobreescribirlo?",36,"¡AVISO IMPORTANTE!")' Aviso en pantalla
if Respuesta=7 Then ' Si se contesta que no
Exit Sub ' Salimos de la macro
End if ' Acabamos la condición
If Respuesta=6 Then ' Si se contesta que si
Kill (RutaDocumento) ' Eliminamos el documento
FilecopY(Documento,RutaDocumento) ' Recogemos el documento y lo renombramos, dejándolo bien guardadito
Exit Sub ' Salimos de la macro
End if ' Acabamos la condición de respuesta positiva
End if ' Acabamos la condición de si el documento existe
FilecopY(Documento,RutaDocumento) ' Renombramos el documento para guardarlo
'-------------------------------------------------
' Guardamos la ruta del documento en la tabla de documentación recibida
oCon = ThisDatabaseDocument.CurrentController.ActiveConnection ' Activamos la conexión
oStat = oCon.CreateStatement ' Creamos el Statement
sSQL = "INSERT INTO ""tbl_DOC_RECIBIDA"" (""ID_RECIBIDA"",""SE_RECIBE"",""FECHA_RECEPCION"",""HIPERVINCULO"",""INDICIOS_RECIBIDOS"")VALUES('"& IDReg &"', 'TRUE','"& FechaEnt &"','"& RutaDocumento &"', 'FALSE')"
oStat.ExecuteUpdate(sSQL) ' Ejecutamos el SQL
End if ' Acabamos con la condición del FilePicker
End if
End Sub