Ruta Archivo de forma automatica. Modificar macro

[prax3des]

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

 

[AlexanderS]

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

[prax3des]

Muchas gracias AlexanderS,

una consulta, para qu e la macro se active automaticamente al abrir el archivo excel como sería?

 

CONTROL DE PLANOS Y CROQUIS.xlsm

[AlexanderS]

Debes utilizar el evento Workbook_Open(), puedes leer un poco mas acerca de este aquí: https://www.exceleinfo.com/ejecutar-macros-al-abrir-un-archivo-en-excel-con-el-evento-workbook_open/

Saludos.

[prax3des]

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?

[AlexanderS]

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

 

[prax3des]

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

[AlexanderS]

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

[prax3des]

Ahora siiiiii, mil gracias?