Listar Ficheros

... "Se ha producido el error '429' en tiempo de ejecucion: el componente ActiveX no puede crear el objeto" [...]

hola, Jesus !

> ... "Se ha producido el error '429' en tiempo de ejecucion: el

1) revisa en el proyecto de macros, en [menu] herramientas /

[probablemente] habra alguna libreria 'marcada' como: FALTA: o...

2) revisa si tienes 'disponible' [mismo menu] la libreria para los

-> Microsoft Scripting Runtime
-> el archivo con la libreria esta +/- en:

-> es probable que necesites re/instalar/registrar dicha libreria -?-
3) informacion 'general'
-> INFO: Solucionar el error 429 al automatizar las aplicaciones de

-> http://tinyurl.com/5vjyx

comentas?
saludos,
hector

Hola que tal,.. bastante ayuda me han dado en estos dias,.. tengo un

que es de Fernando Arroyo, pro me esta saliendo algo mal,.. "Se ha

el error '429' en tiempo de ejecucion: el componente ActiveX no puede

el objeto"

Haber si me pueden ayudar, no he visto a Fernando en respuesta por aqui de
algun foro, aquizas se encuentre ausente, peor tengo la seguridad de que

amigo de aqui o de los Master me ayudara,.. gracias y hasta pronto.

saludos
- aqui estampo el codigo
Public wksH As Worksheet

Public lngContFila As Long



Sub Llamar()

Set wksH = Worksheets("Hoja1") 'Hoja donde se mostrarán los ficheros



Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object

Dim Fichero As Object, tmpFichero As Object

Dim strRutaInicial As String



strRutaInicial = "C:\Datos\Excel" 'Ruta que se procesará



Set fso = CreateObject("Scripting.FileSystemObject")

Set fCarpeta = fso.GetFolder(strRutaInicial)



wksH.Range("A1") = "Ruta"

wksH.Range("B1") = "Nombre"

wksH.Range("C1") = "Tamaño"

wksH.Range("D1") = "Fecha Modif."

wksH.Range("E1") = "Nombre largo"



lngContFila = 2



For Each tmpFichero In fCarpeta.Files



wksH.Cells(lngContFila, 1) = fCarpeta.path

wksH.Cells(lngContFila, 2) = tmpFichero.ShortName

wksH.Cells(lngContFila, 3) = tmpFichero.Size

wksH.Cells(lngContFila, 4) = tmpFichero.DateLastModified

wksH.Cells(lngContFila, 5) = tmpFichero.Name



lngContFila = lngContFila + 1

If lngContFila > 65535 Then

MsgBox prompt:="Demasiados ficheros.", Buttons:=vbCritical +
vbOKOnly, Title:="EscribirEnArchivos"

Exit Sub

End If



Next tmpFichero



Set tmpFichero = Nothing

Set Fichero = Nothing

Set tmpCarpeta = Nothing

Set fCarpeta = Nothing

Set fso = Nothing



EscribirArchivos2 strRutaInicial



With wksH

.Range("A1:E1").HorizontalAlignment = xlCenter

.Range("A1:E1").Font.Bold = True

.Cells(lngContFila, 3).Formula = "=SUM(C2:B" & lngContFila - 1 &

.Range("C2:C" & lngContFila).NumberFormat = "#,##0"

.Range("D2:D" & lngContFila).NumberFormat = "dd-mm-yy hh:mm:ss"

End With



wksH.Columns("A:E").AutoFit



Set wksH = Nothing

End Sub



Public Sub EscribirArchivos2(RutaInicial As String)



On Error GoTo ManejoErrores



Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object

Dim Fichero As Object, tmpFichero As Object



Set fso = CreateObject("Scripting.FileSystemObject")

Set fCarpeta = fso.GetFolder(RutaInicial)



For Each tmpCarpeta In fCarpeta.SubFolders

For Each tmpFichero In tmpCarpeta.Files



wksH.Cells(lngContFila, 1) = tmpCarpeta.path

wksH.Cells(lngContFila, 2) = tmpFichero.ShortName

wksH.Cells(lngContFila, 3) = tmpFichero.Size

wksH.Cells(lngContFila, 4) = tmpFichero.DateLastModified

wksH.Cells(lngContFila, 5) = tmpFichero.Name



lngContFila = lngContFila + 1

If lngContFila > 65535 Then

MsgBox prompt:="Demasiados ficheros.", Buttons:=vbCritical

vbOKOnly, Title:="EscribirEnArchivos"

Exit Sub

End If



Next



EscribirArchivos2 tmpCarpeta.path



Next



Set tmpFichero = Nothing

Set Fichero = Nothing

Set tmpCarpeta = Nothing

Set fCarpeta = Nothing

Set fso = Nothing



Exit Sub



ManejoErrores:

'En Windows XP, algunos ficheros del sistema (como el de paginación)
carecen de nombre corto, por lo que hay que capturar el error que se

al intentar acceder a él (propiedad ShortName).

If Err.Number = 5 Then Resume Next Else MsgBox Err.Number &
Err.Description



End Sub