Microsoft Excel

Herbers Excel/VBA-Archiv

Excel vba Ordner auflisten (Shell)

Betrifft: Excel vba Ordner auflisten (Shell) von: Stefan
Geschrieben am: 21.03.2016 13:54:18

Hallo Zusammen,

Ich hab mir ein kleines Programm geschrieben das mir Ordner und Unterverzeichnisse in einer Excel Tabelle auflistet. Jedoch braucht dieses Programm über 20 Minuten um dies zu tuen. Ich habe erfahren das es mit einer Shell Aplication deutlich schneller gehen soll. Nur sagt mir das rein garnichts.

Bisher mache ich es so :

Option Explicit

Dim fso
Dim lRow As Long
Dim icol As Integer

Sub OrdnerAuflisten()
Set fso = CreateObject("Scripting.FileSystemObject")


icol = 0
lRow = 0    'Ab welcher Zeile soll geschrieben werden
GetSubFolders "Y:\Abl\Projekte"    'Dateipfad für die Suche

End Sub
Function GetSubFolders(pfad)
Dim FO, FU, F
Set FO = fso.GetFolder(pfad)
Set FU = FO.SubFolders

On Error Resume Next

   For Each F In FU
      lRow = lRow + 1   'Eine Zeile weiter
      icol = icol + 1   'Eine Spalte weiter
      
      Sheets(welcheTabelle).Cells(lRow, icol) = F.Name 

      GetSubFolders F.Path

   Next

icol = icol -1

End Function

Wie würde das ganze denn deutlich schneller gehen ?
Suche schon ne ganze Zeit finde aber leider nichts gescheites dazu.

Mit freundlichen Grüßen
SFymaS

  

Betrifft: Ordner auflisten (Shell) von: Anton
Geschrieben am: 21.03.2016 14:50:02

Hallo Stefan,

meinst du sowas?(siehe auch hier):

Private Declare Function OemToCharA Lib "user32.dll" _
    (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

Public Function ASCIItoANSI(ByVal Text As String) As String
  Call OemToCharA(Text, Text)
  ASCIItoANSI = Text
End Function

Sub ordner_auflisten()
  Dim objShell As Object, objExec As Object
  Dim vntRet As Variant, strFolder As String, strTMP As String
  strFolder = "C:\Windows\" 'anpassen
  Set objShell = CreateObject("WScript.Shell")
  ChDrive Left(strFolder, 1)
  ChDir strFolder
  Set objExec = objShell.Exec("cmd /c dir /s /b /a:d *.*")
  strTMP = ASCIItoANSI(objExec.StdOut.ReadAll)  'Idee von Bernd (bst)
  vntRet = Split(strTMP, vbCrLf)
  If UBound(vntRet) > 0 Then Tabelle1.Range("A1").Resize(UBound(vntRet) + 1, 1) = Application. _
Transpose(vntRet)
  Set objExec = Nothing
  Set objShell = Nothing
End Sub
mfg Anton


  

Betrifft: AW: Ordner auflisten (Shell) von: Stefan
Geschrieben am: 21.03.2016 15:22:05

Hallo Anton,

Ja super , ist um 2/3 schneller .
Das hilft mir weiter


  

Betrifft: AW: Excel vba Ordner auflisten (Shell) von: Fennek
Geschrieben am: 21.03.2016 15:42:27

Hallo Stefan,,

warum denn xl, wenn es auch einfach geht. Wenn du ein cmd-Fenster öffnest kannst du mit dem 'dir'-Befehl eine Ordnerstruktur in Sekunden bekommen, und falls nötig, in einer Datei speichern.

Sieh dir zuerst mit dir /? Die Syntax an. Wenn am Bildschirm alles stimmt, dann mit dir *. [größerzeichen] c:\temp\myTxt.txt dir Liste abspeichern.

Mfg


  

Betrifft: AW: Excel vba Ordner auflisten (Shell) von: snb
Geschrieben am: 21.03.2016 16:47:36

sub M_snb()
  sn=split(createobject("wscript.shell").exec("cmd /c dir Y:\Abl\Projekte\*.* /s/b").stdout. _
readall,vbcrlf)

  cells(1).resize(ubound(sn)+1)=application.transpose(sn)
End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Excel vba Ordner auflisten (Shell)"