Public Sub xDirFile(xPath As String, xfn As Double, xSF As String)
    Dim xa      As Long
    Dim xDir    As String
    ReDim xt(0) As String
    Dim xi      As Long
    Dim xAc     As String
    Dim TextLW  As String
    Dim Count   As Long
 
    On Error GoTo Fehler
 
    Count = 1
    'TextLW = frmBilder.txtLaufwerke.Text
 
    xDir = Dir(xPath & "\*.*", vbNormal Or vbReadOnly Or vbHidden _
        Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)
 
    xa = 0
    If Right(xPath, 1) = "\" Then
        xPath = Left(xPath, Len(xPath) - 1)
    End If
    If Len(xDir) > 0 Then
        xt(0) = xDir
    End If
 
    Do While Len(xDir) > 0
        xDir = Dir
        If Len(xDir) > 0 And Not xDir = "." And Not xDir = ".." Then
 
            xa& = xa& + 1
            ReDim Preserve xt(xa)
            xt(xa) = xDir
        End If
    Loop
 
    For xi& = 0 To xa&
        If Len(xt(xi)) = 0 Then
            Exit For
        ElseIf Not xt(xi) = "." And Not xt(xi) = ".." Then
            If Len(Dir$(xPath$ & "\" & xt$(xi&), vbNormal Or vbReadOnly Or _
              vbHidden _
                Or vbSystem Or vbVolume Or vbDirectory Or vbArchive)) > 0 Then
 
                If Not (GetAttr(xPath & "\" & xt(xi)) And vbDirectory) = _
                  vbDirectory Then
 
                    If Len(xSF) > 0 Then
                        If InStr(1, UCase(xt(xi)), xSF) > 0 Then
                            xAc = xPath & "\" & xt(xi)
                            Print #xfn, xAc
 
                        End If
                    End If
                Else
                    'Call xDirFile(xPath & "\" & xt(xi), xfn, xSF)
                End If
            End If
        End If
        DoEvents
    Next xi&
    Exit Sub
Fehler:
    Exit Sub
End Sub

     Call xDirFile(xPath, WF1, ".JPG")