Ordner, Dateien auslesen Dateiendung

[Andyle]

Hallo Euch allen!

Wie kann ich meinen Code erweitern, so dass wenn garkeine Datei nach dem Durchlauf mit entsprechender Endung (Bsp. .txt) vorhanden ist
eine MsgBox kommt?

Wenn Dateien mit der Endung vorhanden sind soll der die Anzahl der dateien in einer MsgBox anzeigen.

Vielen Dank!

Code:

Sub Auslesen1()
Dim objShell As Object
Dim objFolder As Object
Dim x As Object
Dim y As Object

If Range("A1") <> "" Then
Call del_b
End If

  Set objShell = CreateObject("Shell.Application")
  With objShell
  If Range("D4") = "" Then
    Set objFolder = .BrowseForFolder(0&, "Pfad", 0, "" & Range("D1") & "")
    Else
    Set objFolder = .BrowseForFolder(0&, "Pfad", 0, "" & Range("D1") & Range("D4") & "\")
    End If
  End With

Set x = CreateObject("Scripting.FileSystemObject")

If (Not objFolder Is Nothing) Then
Set y = x.GetFolder(objFolder.self.Path)

Else
  Exit Sub
  End If
'Set y = x.GetFolder(ActiveWorkbook.Path)


[a1] = "HAUPTORDNER: " & y.Path
[a1].Interior.Color = vbBlue
[a1].Font.Color = RGB(255, 255, 255)
Dateien y.Files
Ordner y
End Sub

Ordner

Code:

Sub Ordner(Objekt As Object)
Dim Ordnername$, Ordnername2$
Dim Item As Object
For Each Item In Objekt.SubFolders
    [a65536].End(xlUp).Offset(1, 0) = "Unterordner: -> " & Item.Name
    [a65536].End(xlUp).Font.Color = RGB(0, 0, 0)
    [a65536].End(xlUp).Font.Bold = True
'    [a65536].End(xlUp).Interior.Color = RGB(50, 250, 0)
    Dateien Item.Files
    Ordner Item
Next
End Sub

Dateien

Code:

Sub Dateien(Objekt As Object)
Dim Item As Object

For Each Item In Objekt

'Dateiendung prüfen
'mit Punkt
'If InStrRev(Item.Name, "." & Range("D2")) > 0 Then
'ohne Punkt
If InStrRev(Item.Name, Range("D2")) > 0 Then
   
    [a65536].End(xlUp).Offset(1, 0) = "=HYPERLINK(" & _
                    """" & Item.Path & """," & _
                    """" & Item.Name & """)"
                   
End If
                   
Next

End Sub

[UweD]

Hallo

Zähle eine Variable hoch, wenn eine Datei eingefügt wird.

Ganz oben als Public definieren
im Dateien Sub hochzählen
am Programmende prüfen, ob >0

Code:

Public Anz As Long
Sub Auslesen1()
Dim objShell As Object
Dim objFolder As Object
Dim x As Object
Dim y As Object
Anz = 0
If Range("A1") <> "" Then
    Call del_b
End If
  Set objShell = CreateObject("Shell.Application")
  With objShell
  If Range("D4") = "" Then
    Set objFolder = .BrowseForFolder(0&, "Pfad", 0, "" & Range("D1") & "")
    Else
    Set objFolder = .BrowseForFolder(0&, "Pfad", 0, "" & Range("D1") & Range("D4") & "\")
    End If
  End With
Set x = CreateObject("Scripting.FileSystemObject")
If (Not objFolder Is Nothing) Then
Set y = x.GetFolder(objFolder.self.Path)
Else
  Exit Sub
  End If
'Set y = x.GetFolder(ActiveWorkbook.Path)
[a1] = "HAUPTORDNER: " & y.Path
[a1].Interior.Color = vbBlue
[a1].Font.Color = RGB(255, 255, 255)
Dateien y.Files
Ordner y
If Anz = 0 Then
    MsgBox "Keine Dateien gefunden"
Else
    MsgBox Anz & " Dateien gefunden"
End If
End Sub


Sub Ordner(Objekt As Object)
Dim Ordnername$, Ordnername2$
Dim Item As Object
For Each Item In Objekt.SubFolders
    [a65536].End(xlUp).Offset(1, 0) = "Unterordner: -> " & Item.Name
    [a65536].End(xlUp).Font.Color = RGB(0, 0, 0)
    [a65536].End(xlUp).Font.Bold = True
'    [a65536].End(xlUp).Interior.Color = RGB(50, 250, 0)
    Dateien Item.Files
    Ordner Item
Next
End Sub


Sub Dateien(Objekt As Object)
Dim Item As Object
For Each Item In Objekt
'Dateiendung prüfen
'mit Punkt
'If InStrRev(Item.Name, "." & Range("D2")) > 0 Then
'ohne Punkt
If InStrRev(Item.Name, Range("D2")) > 0 Then
    Anz = Anz + 1
    [a65536].End(xlUp).Offset(1, 0) = "=HYPERLINK(" & _
                    """" & Item.Path & """," & _
                    """" & Item.Name & """)"
                  
End If
                  
Next
End Sub

[HKindler]

Hi,

globale Variablen sind bääh.

Besser ist es aus den Subs jeweils eine Function zu machen, die die Anzahl der tatsächlich bearbeiten Dateien zurück gibt. Im Hauptprogramm wird dann eine entsprechende lokale Variable hochgezählt:

Code:

Sub Hauptprogramm()
Dim Anz As Long
Dim i As Long
For i = 1 to 10
    Anz = Anz + TuWas(i)
Next i
MsgBox Anz & " Dinge getan"
End Sub

Function TuWas(Wert As Long) As Long
If CLng(i / 2) = i / 2 Then
    TuWas = 1
End If
End Function

[snb]

Wie kann ich meinen Code erweitern, so dass wenn garkeine Datei nach dem Durchlauf mit entsprechender Endung (Bsp. .txt) vorhanden ist
eine MsgBox kommt?

Wenn Dateien mit der Endung vorhanden sind soll der die Anzahl der dateien in einer MsgBox anzeigen.

Wohin ?, Wozu ?, und dann ??

[Andyle]

Erstmal vielen Dank an euer Interesse.

Habe mal beide Codes getestet.
Leider kommt immer ein falsches Ergebnis heraus. Selbst wenn keine Datei gefunden wurde, gibt er ein Ergebnis bei beiden Codes.

[HKindler]

Andyle,

Was soll den hier „beide Codes“ heißen? Mein Code soll nur das Prinzip veranschaulichen und wird dir immer 5 liefern.

[Andyle]

Auch wenn es vieleicht nicht die beste Lösung ist, aber es funzt!

Danke @UweD

[HKindler]

Was „funzt“?

[Andyle]

Der Code von @UweD!

[RPP63]

Moin!
Wenn ich wissen will, wie viele txt-Dateien in einem Ordner sind
• rufe ich den Explorer auf und
• filtere den Dateityp
   

Rechts wird mir die Anzahl angezeigt.

Aber gut, ist halt nicht so "spannend" wie ein VBA-Code.
(der Jahrzehnte alt sein dürfte [A65536])