Public Function FileList(fldr As String, Optional fltr As String = "*.*") As _
  Variant
    Dim sTemp As String, sHldr As String
    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
    sTemp = Dir(fldr & fltr)
    If sTemp = "" Then
        FileList = Split("No files", "|")  'ensures an  array is returned
        Meldung = MsgBox("Es wurde keine Datei " & fltr & " gefunden." & vbCrLf _
          & "Weiter machen?", vbYesNo)
        If Meldung = vbNo Then End
        Exit Function
    End If
    Do
        sHldr = Dir
        If sHldr = "" Then Exit Do
        sTemp = sTemp & "|" & sHldr
    Loop
    FileList = Split(sTemp, "|")
  End Function
 
Private Sub aktualisieren_Click()
' Macro zur Übersicht des MeasImport-Laufwerkes
 
' Display the names in C:\ that represent directories.
Kpath = "k:\"  ' Set the path.
datapath = "G:\Test-Coordination (01424471)\WO-Closed\"
kanalpath = "g:\dynamic (01424474)\Test Data\Vorlagen\Kanallisten\"
myName = Dir(Kpath, vbDirectory)    ' Retrieve the first entry.
 
zeile_ = 3
 
Worksheets("MeasImport").Range("H1").Value = Now()
 
Range("A3").Select
Do While myName <> ""   ' Start the loop.
Debug.Print myName
' Ignore the current directory and the encompassing directory.
If myName <> "." And myName <> ".." Then '
'MsgBox (Mid(myname, 1, 1))
 
'Use bitwise comparison to make sure MyName is a directory.
    If (GetAttr(Kpath & myName) And vbDirectory) = vbDirectory Then
 
        If (Mid(myName, 1, 1) = "0" Or Mid(myName, 1, 1) = "1" Or Mid(myName, _
          1, 1) = "2" Or Mid(myName, 1, 1) = "3" Or Mid(myName, 1, 1) = "4" Or _
          Mid(myName, 1, 1) = "5" Or Mid(myName, 1, 1) = "6" Or Mid(myName, 1, _
          1) = "7" Or Mid(myName, 1, 1) = "8" Or Mid(myName, 1, 1) = "9") And _
          Mid((Right(myName, 4)), 1, 1) <> "." Then
            Debug.Print myName  ' Display entry only if it
            MsgBox myName
            Worksheets("MeasImport").Range("B" & zeile_).Value = myName
 
 
 
        'Kanalliste
 
            kw_ = Mid(myName, 1, 2)
            wo_ = Mid(myName, 3, 7)
            to_ = Mid(myName, 3)
 
            Liste = FileList(kanalpath & "Kw" & kw_ & "\", myName & ".xls")
          If Liste(0) <> "No files" Then
            Anzahl = UBound(Liste) - LBound(Liste) + 1
            Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
            Worksheets("MeasImport").Range("C" & zeile_).Value = " x "
            Auswahl = MsgBox(Meldung, vbOKCancel)
          Else
            Worksheets("MeasImport").Range("C" & zeile_).Value = ""
          End If
 
 
 
        'Testreport
 
                Liste = FileList(Kpath & myName & "\", "*testreport_sledx*")
 
            If Liste(0) <> "No files" Then
                Anzahl = UBound(Liste) - LBound(Liste) + 1
                Meldung = "Anzahl der gefundenen Dateien: " & Anzahl
                Worksheets("MeasImport").Range("G" & zeile_).Value = " x "
                Range("B" & zeile_).Select
                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
                Kpath & myName & "\testreport_sledx.docx"
                With Selection.Font.Size = 8
                Auswahl = MsgBox(Meldung, vbOKCancel)
                End With
            Else
                Worksheets("MeasImport").Range("C" & zeile_).Value = ""
            End If