Saltar al contenido

Ruta Archivo de forma automatica. Modificar macro

publicado

Hola,

estoy intentando modificar esta macro para poder obtener una ruta del archivo excel del forma automatica.

Cambiar

HostFolder = "C:\TestFolder"

por la ruta que obtengo de concatenar 2 celdas

 

Sub startIt()

   Dim FileSystem As Object
   Dim HostFolder As String

   HostFolder = "C:\TestFolder"

   Set FileSystem = CreateObject("Scripting.FileSystemObject")
   DoFolder FileSystem.GetFolder(HostFolder)

 End Sub

 Sub DoFolder(Folder)


    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
      DoFolder SubFolder
    Next

    i = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Dim File
    For Each File In Folder.Files
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:= _
          File.Path, TextToDisplay:=File.Path
      Cells(i, 2).Value = File.DateCreated

      i = i + 1

    Next


End Sub

 

Featured Replies

publicado
Hace 15 minutos , prax3des dijo:

Cambiar

HostFolder = "C:\TestFolder"

por la ruta que obtengo de concatenar 2 celdas

Suponiendo que las 2 celdas son A1 y A2:

HostFolder = Range("A1") & Range("A2")

Saludos

publicado
  • Autor

Nuevamente gracias, ya he logrado ejecutarlo pero tengo otro problema.

Me genera el listado pero al cerrar y abrir el archivo excel me genera nuevamente el listado a continuacion, ¿como puedo hacer para que no me cree archivos duplicados?

publicado

Prueba así:

 Sub DoFolder(Folder)

    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
      DoFolder SubFolder
    Next

    i = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Dim file
    For Each file In Folder.Files
     
    If Range("A:A").Find(file, , , xlWhole) Is Nothing Then
      ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:= _
          file.Path, TextToDisplay:=file.Path
      Cells(i, 2).Value = file.DateCreated

      i = i + 1
    End If
    Next

End Sub

 

publicado
  • Autor

Siii ahora genial, solo he visto que si elimino no se actualiza

publicado
Hace 3 minutos , prax3des dijo:

Siii ahora genial, solo he visto que si elimino no se actualiza

Correcto, pero entonces lo mejor en tu caso borrar toda la lista de archivos de la columna y volver a escribirla seria lo mejor.

 Sub DoFolder(Folder)
 
 Range([B2], [A2].End(xlDown)).Clear

....

Saludos

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.