Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1240to1244
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dir mit *.doc und *.xls ??

Dir mit *.doc und *.xls ?
ing.grohn
Hallo Forum
bisher Liste ich Dateien aus einem Verzeichnis mit:

Sub MandantVerz(SuchName As String)
Dim strFile As String, lngA As Long
Dim strVz As String
Dim MandantVerz As String
Dim Dateivorh As Boolean
Dim BuchVerz As String
Load UF_Dateiliste
BuchVerz = Left(SuchName, 1)
MandantVerz = Workbooks("Jutta.xls").Sheets("Konstanten").Range("Mandanten").Value
Dateivorh = False
strVz = LW & MandantVerz & BuchVerz & "\*" & SuchName & "*.doc"
strFile = Dir(strVz, vbNormal)
While strFile  ""
UF_Dateiliste.ListBox1.AddItem _
LW & MandantVerz _
& BuchVerz & "\" & strFile
strFile = Dir
Dateivorh = True
Wend
strVz = LW & MandantVerz & BuchVerz & "\*" & SuchName & "*.xls"
strFile = Dir(strVz, vbNormal)
While strFile  ""
UF_Dateiliste.ListBox1.AddItem _
LW & MandantVerz _
& BuchVerz & "\" & strFile
strFile = Dir
Dateivorh = True
Wend
If Dateivorh = True Then
UF_Dateiliste.Show
Unload UF_Dateiliste
Else
MsgBox ("Zum Mandanten(Kurzname) " & strVz & Buchstabe & " sind keine Dateien vorhanden")
End If
End Sub

Funktioniert
Dadurch, dass ich erst *.doc und dann *.xls suche ist das natürlich etwas umständlich.
Kann man das Ganze eleganter abwickeln?
Wenn JA, wie?
freue mich auf eure antworten.
Mit freundlichen Grüßen
Albrecht

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Dir mit *.doc und *.xls ?
30.11.2011 21:17:25
Josef

Hallo Albrecht,
ungetestet!
Sub MandantVerz(SuchName As String)
  Dim strFile As String
  Dim strVz As String
  Dim MandantVerz As String
  Dim BuchVerz As String
  Dim vntList() As Variant, lngIndex As Long
  
  
  BuchVerz = Left(SuchName, 1)
  MandantVerz = Workbooks("Jutta.xls").Sheets("Konstanten").Range("Mandanten").Value
  
  strVz = LW & MandantVerz & BuchVerz & "\*" & SuchName & "*.*"
  strFile = Dir(strVz, vbNormal)
  
  Do While strFile <> ""
    If strFile Like "*.doc*" Or strFile Like "*.xls*" Then
      Redim Preserve vntList(lngIndex)
      vntList(lngIndex) = LW & MandantVerz _
        & BuchVerz & "\" & strFile
      lngIndex = lngIndex + 1
    End If
    strFile = Dir
  Loop
  
  If lngIndex > 0 = True Then
    With UF_Dateiliste
      .ListBox1.List = vntList
      .Show
    End With
  Else
    MsgBox ("Zum Mandanten(Kurzname) " & strVz & Buchstabe & " sind keine Dateien vorhanden")
  End If
  
End Sub



« Gruß Sepp »

Anzeige
AW: Dir mit *.doc und *.xls ?
30.11.2011 22:05:18
ing.grohn
Hallo Sepp
erst mal vieln Dank.
Funktioniert, aber nicht zufriedenstellend.
1. es entstehen Lücken
2. die Liste ist unsortiert (nach Erweiterung)
siehe Bild:
Userbild
Hast Du ne Idee für die Sortierung bzw Lücken?
Mit ferundlichen Grüßen
Albrecht
AW: Dir mit *.doc und *.xls ?
30.11.2011 22:21:58
Josef

Hallo Albrecht,
sortieren ist kein Problem, allerdings fügt mein Code sicher keine "Lücken" ein. (getestet!)
Sub MandantVerz(SuchName As String)
  Dim strFile As String
  Dim strVz As String
  Dim MandantVerz As String
  Dim BuchVerz As String
  Dim vntList() As Variant, lngIndex As Long
  
  
  BuchVerz = Left(SuchName, 1)
  MandantVerz = Workbooks("Jutta.xls").Sheets("Konstanten").Range("Mandanten").Value
  
  strVz = LW & MandantVerz & BuchVerz & "\*" & SuchName & "*.*"
  strFile = Dir(strVz, vbNormal)
  
  Do While strFile <> ""
    If strFile Like "*.doc*" Or strFile Like "*.xls*" Then
      Redim Preserve vntList(lngIndex)
      vntList(lngIndex) = Mid(strFile, InStrRev(strFile, ".") + 1, 1) & _
        " " & LW & MandantVerz & BuchVerz & "\" & strFile
      lngIndex = lngIndex + 1
    End If
    strFile = Dir
  Loop
  
  If lngIndex > 0 = True Then
    QuickSort vntList
    For lngIndex = 0 To UBound(vntList)
      vntList(lngIndex) = Mid(vntList(lngIndex), 3)
    Next
    With UF_Dateiliste
      .ListBox1.List = vntList
      .Show
    End With
  Else
    MsgBox ("Zum Mandanten(Kurzname) " & strVz & Buchstabe & " sind keine Dateien vorhanden")
  End If
  
End Sub


Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
  Dim P1&, P2&, T1 As Variant, T2 As Variant
  
  UG = IIf(IsMissing(UG), LBound(data), UG)
  OG = IIf(IsMissing(OG), UBound(data), OG)
  
  P1 = UG
  P2 = OG
  T1 = data((P1 + P2) / 2)
  
  Do
    
    Do While (data(P1) < T1)
      P1 = P1 + 1
    Loop
    
    Do While (data(P2) > T1)
      P2 = P2 - 1
    Loop
    
    If P1 <= P2 Then
      T2 = data(P1)
      data(P1) = data(P2)
      data(P2) = T2
      P1 = P1 + 1
      P2 = P2 - 1
    End If
    
  Loop Until (P1 > P2)
  
  If UG < P2 Then QuickSort data, UG, P2
  If P1 < OG Then QuickSort data, P1, OG
  
End Sub



« Gruß Sepp »

Anzeige
AW: Dir mit *.doc und *.xls ?
30.11.2011 22:31:31
ing.grohn
Hallo Sepp,
das mit den Lücken war mein Fehler!!
Die Lösung ist klasse und hilft mir auch woanders weiter
Vielen Dank!!
Wünsch Dir einen schönen restlichen Abend (wär für mich schöner wenn 96 gewinnen würde)
Mit freundlichen Grüßen
Albrecht
AW: Dir mit *.doc und *.xls ? Korrektur
30.11.2011 22:09:22
ing.grohn
Hallo Sepp (Korrektur)
erst mal vieln Dank.
Funktioniert, aber nicht zufriedenstellend.
1. es entstehen Lücken !!STIMMT NICHT ist OK
2. die Liste ist unsortiert (nach Erweiterung)
siehe Bild:
Userbild
Hast Du ne Idee für die Sortierung ?
Mit ferundlichen Grüßen
Albrecht
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige