............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Simular Dir del antiguo DOS

Ver el tema anterior Ver el tema siguiente Ir abajo

Simular Dir del antiguo DOS

Mensaje por Tatayayan el Sáb Ago 20, 2011 12:27 pm

Hola, hoy soy el simulador, jajaja, otra simulación.
Código:
Sub ListarArchivos()
Dim Direc As FileDialog, x As Long
Dim ObjFSO, objStartFolder, objFolder, colFiles, objFile
Set Direc = Application.FileDialog(msoFileDialogFolderPicker)
If Direc.Show = 0 Then Exit Sub
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = Direc.SelectedItems(1) & "\"
Range("B1").Value = "Archivos de " & objStartFolder
Range("B:B").Columns.AutoFit
Set objFolder = ObjFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
x = 1
Range("A:A").ClearContents
For Each objFile In colFiles
    Range("A" & x).Value = objFile.Name
    x = x + 1
Next
Range("A:A").Columns.AutoFit
End Sub
avatar
Tatayayan
Moderador
Moderador

Masculino Cantidad de envíos : 319
Ciudad - Pais : Chamical- La Rioja - ARG
Fecha de inscripción : 20/11/2008

Volver arriba Ir abajo

Re: Simular Dir del antiguo DOS

Mensaje por Tinno el Jue Ene 26, 2012 8:09 pm

Y si ...agregamos esto:

Código:
Option Explicit
Sub ListarArchivos()
 Dim Direc As FileDialog, Ruta As String, oMiObj As Object, oFile As Object, i As Long
 Dim oSubCarp As Object, Carp As Object, FSO As Object, FileObject As Object
  Set Direc = Application.FileDialog(msoFileDialogFolderPicker)
      Range("A2:E" & Rows.Count).ClearContents
    If Direc.Show = 0 Then Exit Sub
      Ruta = Direc.SelectedItems(1): i = 2
  Set oMiObj = CreateObject("Scripting.FileSystemObject")
  Set oFile = CreateObject("Scripting.FileSystemObject")
  Set oSubCarp = oMiObj.GetFolder(Ruta).SubFolders
  Set FSO = CreateObject("Scripting.FileSystemObject")
      With oMiObj
        For Each oFile In .GetFolder(Ruta).Files
            Range("A" & i) = oFile.Name
        Set FileObject = FSO.GetFile(Ruta & "\" & oFile.Name)
            Cells(i, 2).Value = FSO.GetExtensionName(oFile.Name)
            Cells(i, 3).Value = FileObject.DateCreated
            Cells(i, 4).Value = FileObject.DateLastAccessed
            Cells(i, 5).Value = FileObject.DateLastModified
        Set FileObject = Nothing
          i = i + 1
        Next
            For Each Carp In oSubCarp
              Range("A" & i) = "[" & Carp.Name & "]"
                  ListaFile (Ruta & "\" & Carp.Name)
              i = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Next
      End With
  Set Direc = Nothing
  Set oMiObj = Nothing
  Set oFile = Nothing
  Set oSubCarp = Nothing
  With [A1:E1]
        .EntireColumn.AutoFit
        .Value = [{"Carp/File","Ext","Created", "Last Accessed", "Last Modoified"}]
        .HorizontalAlignment = xlCenter
  End With
End Sub
Sub ListaFile(Ruto$)
 Dim Direct As FileDialog, oFileT, ia&
 Dim FSOd As Object, FileObjD As Object
  Set Direct = Application.FileDialog(msoFileDialogFolderPicker)
      ia = Cells(Rows.Count, 1).End(xlUp).Row + 1
  Set oFileT = CreateObject("Scripting.FileSystemObject")
  Set FSOd = CreateObject("Scripting.FileSystemObject")
      With CreateObject("Scripting.FileSystemObject")
          For Each oFileT In .GetFolder(Ruto).Files
            Range("A" & ia) = oFileT.Name
            Set FileObjD = FSOd.GetFile(Ruto & "\" & oFileT.Name)
            Cells(ia, 2).Value = FSOd.GetExtensionName(oFileT.Name)
            Cells(ia, 3).Value = FileObjD.DateCreated
            Cells(ia, 4).Value = FileObjD.DateLastAccessed
            Cells(ia, 5).Value = FileObjD.DateLastModified
        Set FileObjD = Nothing
            ia = Cells(Rows.Count, 1).End(xlUp).Row + 1
          Next
      End With
  Set oFileT = Nothing
  Set Direct = Nothing
End Sub

...ahora.

Tinno

Masculino Cantidad de envíos : 8
Edad : 34
Ciudad - Pais : México, D.F.
Version de Excel : 2003-2007
Fecha de inscripción : 15/02/2011

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.