Tælle antal workbooks i en mappe (VBA)

Hej

Har fundet denne:
(Afprøvet i  Excel-2003)
Bemærk: Range("A1:A1000").ClearContents
Forbereder til liste
Antal i B1.

Sub filliste()
    Dim FS As FileSearch
    Dim FilePath As String, FileSpec As String
    Dim i As Long, t As Integer
    Dim v As Variant
    Dim rTarget As Range
    Dim ToSheet As Worksheet
    '******************************
    FilePath = ThisWorkbook.Path
    FileSpec = "*.xls"
    Set ToSheet = ThisWorkbook.Worksheets("ark1")
    '******************************
    'find excel filerne
    Set FS = Application.FileSearch
    With FS
        .LookIn = FilePath
        .Filename = FileSpec
        .SearchSubFolders = False          'skal underfoldere også søges
        .Execute
        If .FoundFiles.count = 0 Then
            MsgBox ("Ingen filer fundet")
            Exit Sub
        End If
    End With
    Range("A1:A1000").ClearContents
    Range("A1") = "antal filer:"
    Range("B1") = FS.FoundFiles.count
    For i = 1 To FS.FoundFiles.count
        For t = 1 To Len(FS.FoundFiles(i))
            If Mid(FS.FoundFiles(i), t, 1) = "\" Then sidst = t
        Next t
        ToSheet.Range("A1").Offset(i, 0) = Mid(FS.FoundFiles(i), sidst + 1, Len(FS.FoundFiles(i)) - sidst)
    Next i
End Sub

Lavet af: jlemming d. 29. november 2007
http://www.eksperten.dk/spm/808097

mvh
  Morten

Hej
Som beskrevet findes filesearch desværre ikke i Excel 2007, og din løsning kan derfor ikke bruges... :(

Sub TælXLS()
sti = "C:\Users\pm\Desktop\" ' ret til aktuel sti
fil = Dir(sti & "*.xls")
Do While fil <> ""
  tal = tal + 1
  fil = Dir()
Loop
MsgBox tal
End Sub

Ups!!! min fejl.

excelent´s løsning med en lille tilføjelse.

Sub TælXLS()
sti = ThisWorkbook.Path & "\"    'denne mappe
fil = Dir(sti & "*.xls")
Do While fil <> ""
  tal = tal + 1
  fil = Dir()
Loop
Range("A1") = "Antal filer: " & tal    'resulstat skrives
MsgBox tal
End Sub

Tak mange gange til Jer begge. Brugte excelents løsning som virker perfekt!

ok velbekom

ok velbekomme

Jeg har behov for næsten at gøre det samme.

Men vil gerne lægge workbook navene ind i et array, hvordan gøres dette?

Ja jeg har også set dit spørgsmål, og lavet en løsning
Men hvis du kikker på dine gamle spørgsmål, så kan du nok regne ud hvorfor jeg ikke spilder tid på dig

Har jeg ikke givet point?

Nej så længe prikkerne ikke er grønne, er spørgsmål ikke afsluttet

men kan se du  er på rette vej, så du får lige en stump kode
som indsætter projektnavne i kolonne A
samt indsættes i Variablen Projektmapper()
Ret sti til aktuel
Hvis der er flere end 100 filer, så forhøj Dim 100 til aktuel

Sub ListXLS()
Dim Projektmapper(100)
sti = "C:\Users\pm\Desktop\*.xls"
fil = Dir(sti)
Do While fil <> ""
  Projektmapper(tal) = fil
  Cells(tal + 1, 1) = Projektmapper(tal)
  tal = tal + 1
  fil = Dir
Loop
End Sub

Fandt lige:

BST Utilities --> Filer og Mapper --> Filnavne Scanner.