Página 1 de 1

[RESUELTO] Renombrar hoja según nombre de archivo

NotaPublicado: Lun Ago 27, 2018 7:56 am
por albfernan
Tengo varias carpetas en Windows que dentro contienen uno o mas ficheros ods, quisiera renombrar la pestaña de cada fichero ods por el mismo nombre del fichero, ¿sabéis si es posible?

Código: Seleccionar todo   Expandir vistaContraer vista
carpeta1
    fichero1(nombre pestaña xx, cambiar a fichero1)
carpeta2
    fichero1(nombre pestaña xx, cambiar a fichero1)
    fichero2(nombre pestaña xx, cambiar a fichero2)
carpeta3
    fichero1(nombre pestaña xx, cambiar a fichero1)
etc...

Re: Renombrar hoja según nombre de archivo

NotaPublicado: Lun Ago 27, 2018 11:03 am
por albfernan
bueno, estoy avanzando, me falta que lea los ficheros de las subcarpetas y que se guarden los cambios al cerrar el archivo que no lo hace y no entiendo porque.

Código: Seleccionar todo   Expandir vistaContraer vista
Sub EjemploDir()
    Dim cArchivo As String
    Dim ruta As String
    Dim cArchivoSinExt As String
    ruta="D:\OFICIOS\"
   
    cArchivo = Dir(ruta + "*.ods", 0)

    Do While cArchivo>""
       'MsgBox cArchivo
       'cArchivo=Dir
       
        'abrimos el archivo
        Url = convertToUrl(ruta + cArchivo)
        'MsgBox Url
   Dim Doc
   Doc = starDeskTop.loadComponentFromUrl (Url, "_blank", 0, Array())
       
        'renombramos la hoja por el nombre del archivo
        Dim oSheet
   oSheet = ThisComponent.CurrentController.ActiveSheet
   cArchivoSinExt=Replace(cArchivo,".ods","")
     'cArchivoSinExt = join(split(cArchivo, ".ods"), NewPart)
      
   MsgBox cArchivoSinExt
   oSheet.Name = cArchivoSinExt
       
        'cerramos salvando el archivo
        Doc.close(true)
        'fnSave = true
        'fnClose = true
        'ThisComponent.Close(True)
       
        cArchivo=Dir
    Loop

    MsgBox "No quedan más archivos"

End Sub


Re: Renombrar hoja según nombre de archivo

NotaPublicado: Lun Ago 27, 2018 2:41 pm
por FJCC-ES
albfernan escribió:me falta que ... se guarden los cambios al cerrar el archivo


Doc.close(true) cierra el archivo. Para guardarlo, use
Código: Seleccionar todo   Expandir vistaContraer vista
Doc.store()

Re: Renombrar hoja según nombre de archivo

NotaPublicado: Mar Ago 28, 2018 8:17 am
por albfernan
FJCC-ES escribió:
albfernan escribió:me falta que ... se guarden los cambios al cerrar el archivo


Doc.close(true) cierra el archivo. Para guardarlo, use
Código: Seleccionar todo   Expandir vistaContraer vista
Doc.store()


funciona, muchas gracias

Re: [RESUELTO] Renombrar hoja según nombre de archivo

NotaPublicado: Mar Ago 28, 2018 9:28 am
por albfernan
Bueno pues al final lo he terminado, me ha costado más ya que no fui capaz de utilizar el Dir anidado que era lo que tenia en mente, así que leí el contenido de la carpeta y lo guarde en un array que luego recorro abriendo los archivos. Tampoco se crear un array con indice variable así que lo dejé fijo a 100 ya que el directorio contenía menos carpetas.
Me ha funcionado perfectamente, dejo el código:

Código: Seleccionar todo   Expandir vistaContraer vista
'lista un directorio dado y guarda las carpetas que contiene en un array
'recorremos el array de carpetas y leemos los ficheros que contiene
'se renombran las hojas de cada fichero por el nombre del mismo
Sub DirRenSheet()
   'creamos un array con las carpetas a leer
    Dim cDir As String
    Dim conta As Integer
    Dim arrayCarpetas(100) As Variant
    Dim path As String
    path="D:\OFICIOSP\"
    conta=-1
    cDir = Dir(path, 16)

    Do While cDir>""
       Select Case Left(cDir,1)
         'Nos saltamos los ocultos
         Case ".", ".."
         Case Else
                conta=conta+1
                arrayCarpetas(conta) = cDir
               'MsgBox conta & "-" & cDir
      End Select
       'siguiente directorio
       cDir=Dir
    Loop
    'MsgBox "No quedan más carpetas"
   
    'recorremos el array de carpetas y procesamos los ficheros que contienen
    Dim co1 As Integer
     'msgbox(LBound(MyArray()))
     'msgbox(UBound(MyArray()))
    For co1 = 0 To conta
       'MsgBox co1 & "-" & arrayCarpetas(co1)
       Dim cArchivo As String
       Dim cArchivoSinExt As String
       Dim carpeta As String
       carpeta=arrayCarpetas(co1)+"\"
       'MsgBox carpeta
       cArchivo = Dir(path+carpeta+"*.ods", 0)
      'MsgBox cArchivo
       Do While cArchivo>""
           'abrimos el archivo
           Url = convertToUrl(path+carpeta+cArchivo)
         Dim Doc
         Doc = starDeskTop.loadComponentFromUrl (Url, "_blank", 0, Array())
          
           'renombramos la hoja por el nombre del archivo
           Dim oSheet
         oSheet = ThisComponent.CurrentController.ActiveSheet
         cArchivoSinExt=Replace(cArchivo,".ods","")
           'cArchivoSinExt = join(split(cArchivo, ".ods"), NewPart)
         'MsgBox cArchivoSinExt
         oSheet.Name = cArchivoSinExt
          
           'guardamos y cerramos el archivo
           Doc.store()
           Doc.close(true)
           'siguiente archivo
           cArchivo=Dir
       Loop
       'MsgBox "No quedan más archivos"
    Next

End Sub