Liste med filnavne fra et bestemt bibliotek?

Du skal bruge commandoen Dir

Her et eksempel fra Excel2000 hjælpen:

\' Display the names in C:\\ that represent directories.
MyPath = \"c:\\\"    \' Set the path.
MyName = Dir(MyPath, vbDirectory)    \' Retrieve the first entry.
Do While MyName <> \"\"    \' Start the loop.
    \' Ignore the current directory and the encompassing directory.
    If MyName <> \".\" And MyName <> \"..\" Then
        \' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
            Debug.Print MyName    \' Display entry only if it
        End If    \' it represents a directory.
    End If
    MyName = Dir    \' Get next entry.
Loop

Hvilken version af Excel har du?

Ovenstående kode virker i både 97 og 2000.

xl 97

Jeg vil gerne have lavet listen i et regneark, er det noget stort problem?

Nej, det er ikke noget problem - brug f.eks. denne her.

Sub FilNavne()
\' Display the names in C:\\ that represent directories.
Dim sFilNavn() As String
Dim iX As Integer, iZ As Integer
    MyPath = \"c:\\\"    \' Set the path.
    MyName = Dir(MyPath, vbDirectory)    \' Retrieve the first entry.
   
    Do While MyName <> \"\"    \' Start the loop.
        \' Ignore the current directory and the encompassing directory.
        If MyName <> \".\" And MyName <> \"..\" Then
            \' Use bitwise comparison to make sure MyName is a directory.
            If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                ReDim Preserve sFilNavn(iX)
                sFilNavn = MyName
            End If    \' it represents a directory.
        End If
        MyName = Dir    \' Get next entry.
        iX = iX + 1
    Loop

    Worksheet(\"Ark1\").Select
    Range(\"A2\").Select
    For iZ = 0 To iX  \'Skal måske være iX-1
        ActiveCell.Offset(iZ, 0) = sFilNavn(iZ)
    Next
End Sub

Selvfølgelig skal du nok rette stien, arknavn og start celle...

Jeg har også en løsning, som generer en liste i et Excel-ark af et ønsket bibiliotek. Interesseret?

flemming -> når jeg kører koden opstår der en kompileringsfejl (Der kan ikke tildeles til matrixen) Derefter markerer den koden sFilnavn=MyName lige før \"end if\"

Jan -> hvis den virker bedre/er mere gennemskuelig (det kan skyldes, jeg er en smule træt, siden jeg ikke umiddelbart kan gennemskue ovenstående)

Udgangspkt kunne være at liste alle filer fra C:\\dokumenter!

Ja, undskyld

Der skal stå

sFilNavn(iX) = MyName

Sorry

Ok, her kommer den. Lavet til Excel 95 men fungerer fint i Excel 97.
Den medtager også alle filer eventuelle underbiblioteker.

Dim GlobalFolderList() As String, GlobalFolderCount As Long


Function FolderList95(InputFolder As String) As Variant
\' returns an array containing the folders in InputFolder
Dim rootFolder As String, Folder As String, Folders() As String, FolderCount As Long
    rootFolder = InputFolder
    If Right(rootFolder, 1) <> \"\\\" Then rootFolder = rootFolder & \"\\\"
    Folder = Dir(rootFolder, vbDirectory) \' retrieve the first folder.
    FolderCount = 0
    While Folder <> \"\" \' start the loop.
        \' ignore the current directory and the encompassing directory.
        If Folder <> \".\" And Folder <> \"..\" Then
            \' Use bitwise comparison to make sure Folder is a directory.
            On Error GoTo FileInUse
            If (GetAttr(rootFolder & Folder) And vbDirectory) = vbDirectory Then
                FolderCount = FolderCount + 1
                ReDim Preserve Folders(FolderCount)
                Folders(FolderCount) = Folder
            End If
        End If
FileInUse:
        Folder = Dir() \' get next folder
    Wend
    FolderList95 = Folders
    \' if you only want to return the number of folders: return the value FolderCount
End Function


Sub RecursiveFolderList95(ByVal InputFolder As String, IncludeSubFolders As Boolean)
\' adds the folders in InputFolder and any subfolders to the global variable GlobalFolderList
Dim rootFolder As String, SubFolders As Variant
Dim i As Long
    rootFolder = InputFolder
    If rootFolder = \"\" Then Exit Sub
    If GlobalFolderCount = 0 Then
        GlobalFolderCount = 1
        ReDim Preserve GlobalFolderList(GlobalFolderCount)
        GlobalFolderList(GlobalFolderCount) = rootFolder
    End If
    If Right(rootFolder, 1) <> \"\\\" Then rootFolder = rootFolder & \"\\\"
    SubFolders = FolderList95(rootFolder)
    On Error GoTo NoFolder
    If TypeName(SubFolders) = \"String()\" Then \' folders found
        For i = 1 To UBound(SubFolders)
            GlobalFolderCount = GlobalFolderCount + 1
            ReDim Preserve GlobalFolderList(GlobalFolderCount)
            GlobalFolderList(GlobalFolderCount) = rootFolder & SubFolders(i)
            If IncludeSubFolders Then
                RecursiveFolderList95 rootFolder & SubFolders(i), IncludeSubFolders
            End If
        Next i
    End If
NoFolder:
    Erase SubFolders
End Sub


Function FolderFileList95(ByVal InputFolder As String, FileFilter As String) As Variant
\' returns an array containing the files matching the FileFilter in InputFolder
Dim List() As String, tFile As String, fCount As Long
    FolderFileList95 = \"\"
    If InputFolder = \"\" Then InputFolder = CurDir
    If Right(InputFolder, 1) <> \"\\\" Then InputFolder = InputFolder & \"\\\"
    If FileFilter = \"\" Then FileFilter = \"*.*\"
    tFile = Dir(InputFolder & FileFilter)
    fCount = 0
    While tFile <> \"\"
        fCount = fCount + 1
        ReDim Preserve List(fCount)
        List(fCount) = tFile
        tFile = Dir
    Wend
    If fCount > 0 Then FolderFileList95 = List
    \' if you only want to return the number of files: return the value fCount
    Erase List
End Function


Function CreateFileList95(FileFilter As String, IncludeSubFolder As Boolean) As Variant
\' returns the full filename for files matching the filter criteria in the current folder
Dim FileList() As String, FileCount As Long, f As Long, tempList As Variant, i As Long
    Erase GlobalFolderList \' global variable: Dim GlobalFolderList() as String
    GlobalFolderCount = 0 \' global variable: Dim GlobalFolderCount as Long
    If FileFilter = \"\" Then FileFilter = \"*.*\" \' all files
    Application.StatusBar = \"Reading folder information...\"
    RecursiveFolderList95 CurDir, IncludeSubFolder
    If GlobalFolderCount > 0 Then \' folders found, find files
        Application.StatusBar = \"Reading file information...\"
        For f = 1 To GlobalFolderCount
            tempList = FolderFileList95(GlobalFolderList(f), FileFilter)
            If TypeName(tempList) = \"String()\" Then
                For i = 1 To UBound(tempList)
                    FileCount = FileCount + 1
                    ReDim Preserve FileList(FileCount)
                    FileList(FileCount) = GlobalFolderList(f) & \"\\\" & tempList(i)
                Next i
            End If
        Next f
    End If
    CreateFileList95 = FileList
    \' if you only want to return the number of files: return the value FileCount
    Erase GlobalFolderList
    Erase FileList
    Application.StatusBar = False
End Function


Sub TestCreateFileList95()
Const SearchRootFolder As String = \"C:\\dokumenter\"
Dim MyFiles As Variant, i As Long
    Application.ScreenUpdating = False
    Application.StatusBar = \"Creating file list...\"
    ChDrive Left(SearchRootFolder, 1) \' activate the desired drive
    ChDir SearchRootFolder \' activate the desired folder
    MyFiles = CreateFileList95(\"*.xls\", True)
    i = 0
    On Error Resume Next
    i = UBound(MyFiles)
    On Error GoTo 0
    If i = 0 Then \' no files found
        MsgBox \"No files matches the file criteria!\"
        Exit Sub
    End If
    Workbooks.Add
    With Range(\"A1\")
        .Formula = \"List of *.xls-files in \" & CurDir & \" and subfolders:\"
        .Font.Bold = True
    End With
    For i = 1 To UBound(MyFiles)
        Cells(i + 1, 1).Formula = MyFiles(i)
    Next i
    Columns(\"A\").AutoFit
    Application.StatusBar = False
End Sub

hehe - hvad har du gang i Jan :-)

Gennemskuelig?????

>>> Flemming

Lidt spændende VBA-kode. Prøv den! Du vil blive overrasket!

>>>Jan - har du da indbygget en virus :-)

Ingen VBA-kode til et sådan problem vil være enkel og gennemskuelig.
Den viser jo trods alt filer i biblioteket - også dem i eventuelle underbiblioteker!

Trykker man ALT+F8 er der kun én makro - kør den!

>>>askims

Denne udgave laver ikke blanke mellemrum, og den LÆSER OGSÅ UNDERBIBLIOTEKER

>>>Jan - prøv en gang :-)

Sub FilNavne()
\' Display the names in C:\\ that represent directories.
Dim sFilNavn() As String
Dim iX As Integer, iZ As Integer
    MyPath = \"D:\\Dokumenter\\VBA\\\"    \' Set the path.
    MyName = Dir(MyPath, vbDirectory)    \' Retrieve the first entry.
   
    Do While MyName <> \"\"    \' Start the loop.
        \' Ignore the current directory and the encompassing directory.
        If MyName <> \".\" And MyName <> \"..\" Then
            \' Use bitwise comparison to make sure MyName is a directory.
            If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                ReDim Preserve sFilNavn(iX)
                sFilNavn(iX) = MyName
                iX = iX + 1
            End If    \' it represents a directory.
        End If
        MyName = Dir    \' Get next entry.
    Loop

    Worksheets(\"Ark1\").Select
    Range(\"A2\").Select
    For iZ = 0 To iX - 1 \'Skal måske være iX-1
        ActiveCell.Offset(iZ, 0) = sFilNavn(iZ)
    Next
End Sub

>>> Flemming

Hahaha, skulle det være en joke?
Den returnerer jo bare bibliotekerne ....

Hvad mener du med, at min løsning laver blanke mellemrum?

>>>Jan, det var nu min første løsning, som lavede blanke mellemrum - jeg har ikke kommenteret din !

flemming >>> Problemos med vba\'en. Når jeg kører din kode skriver den: fejl 53 filen blev ikke fundet. Jeg har rettet stinavnet til c:\\dokumenter. Jeg tror, det er Dir(MyPath, vbDirectory), som den har problemer med. Any ideas??

Husk at afslutte med en \\ således C:\\Dokumenter\\

>>> flemming

OK, men DEN LÆSER IKKE INDHOLDET I UNDERBIBLIOTEKER.
Prøv at se filer i \"c:\\\"!

>>> askims

Prøv lige at give min løsning en enkelt chance ;-)

>>Jan, jo den gør, den returer blot ikke stiangivelsen.

jan >>> Det vil jeg ikke - nej spøg til side, den skal liste samtlige filer i det pågældende bibliotek og ikke bare xl-filer, så ja jeg har afprøvet den! - og den virker næsten efter hensigten bortset fra at den kun medtager xl-filer

Du kan bare ændre i koden til *.* i stedet for *.xls

Det er denne linie i den sidste SUB, som skal ændres:

MyFiles = CreateFileList95(\"*.xls\", True)

flemming >>> kører du en anden version af xl, for når jeg kører kode stumpen lister den også kun underbibliotekerne og ikke de enkelte filer?

OK, så brug jan\'s model.

Ja, sådan ser det også ud på min skærm! Ingen filer - blot biblioteksnavne. Flemming kører vist 2000.

Ja KLART gør jeg det.

Tak Flemming. Rart at du ville indrømme at min model trods alt virkede, selv om den var lidt omstændelig! :-)

Jeg har da aldrig sagt andet - du viser da ind i mellem nogle brugebare løsninger :-)
(omend det er dine egne !?!)

Koden til din 2000 ser måske sådan ud (kan ikke teste den):

Sub TestListFilesInFolder()
    Workbooks.Add \' create a new workbook for the file list
    \' add headers
    With Range(\"A1\")
        .Formula = \"Folder contents:\"
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range(\"A3\").Formula = \"File Name:\"
    Range(\"B3\").Formula = \"File Size:\"
    Range(\"C3\").Formula = \"File Type:\"
    Range(\"D3\").Formula = \"Date Created:\"
    Range(\"E3\").Formula = \"Date Last Accessed:\"
    Range(\"F3\").Formula = \"Date Last Modified:\"
    Range(\"G3\").Formula = \"Attributes:\"
    Range(\"H3\").Formula = \"Short File Name:\"
    Range(\"A3:H3\").Font.Bold = True
    ListFilesInFolder \"C:\\FolderName\\\", True \' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
\' lists information about the files in SourceFolder
\' example: ListFilesInFolder \"C:\\FolderName\\\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range(\"A65536\").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        \' display file properties
        Cells(r, 1).Formula = FileItem.Path & FileItem.Name
        Cells(r, 2).Formula = FileItem.Size
        Cells(r, 3).Formula = FileItem.Type
        Cells(r, 4).Formula = FileItem.DateCreated
        Cells(r, 5).Formula = FileItem.DateLastAccessed
        Cells(r, 6).Formula = FileItem.DateLastModified
        Cells(r, 7).Formula = FileItem.Attributes
        Cells(r, 8).Formula = FileItem.ShortPath & FileItem.ShortName
        \' use file methods (not proper in this example)
\'        FileItem.Copy \"C:\\FolderName\\Filename.txt\", True
\'        FileItem.Move \"C:\\FolderName\\Filename.txt\"
\'        FileItem.Delete True
        r = r + 1 \' next row number
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Columns(\"A:H\").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
End Sub

Jeg får fejl på Scripting.FileSystemObject, og værken Scripting eller FileSystemObject findes i hjælpen.

Det kunne lige et modul fra den rene VisualBasic, som bruger Excel til vise listen i....!

Tak hjælpen - jeg synes det var synd hvis I ikke begge blev præmieret for jeres indsats, så I får 30 point hver. Hvori ligger de store fordele i at opgradere fra xl 97 til 2000, bortset fra der i 2000 er mulighed for at informere brugerne via diverse msgbox\'s uden at brugerne skal trykke på en knap for at makroen fortsætter ?

Prøv at tilføje en reference til: Microsoft Scripting Runtime under VBA :-)

>>>Jan - Det hjælper lidt, men det er ikke nok til et fejlfrit gennemløb \"FileItem.DateCreated\" giver fejl ellers vist OK.

Undskyld jeg forstyrre men en lille meget overskuelig kode som løser mit problem mindst lige så godt som jan\'s kode!

Sub TEST()
    Directory = \"c:\\dokumenter\\\"
    \' indsæt header
    r = 1
    Cells(r, 1) = \"Filnavn\"
    Range(\"a1:c1\").Font.Bold = True
    r = r + 1

    With Application.FileSearch
        .NewSearch
        .LookIn = Directory
        .FileName = \"*.*\"
        .SearchSubFolders = False
        .Execute
        For i = 1 To .FoundFiles.Count
            Cells(r, 1) = .FoundFiles(i)
            r = r + 1
        Next i
    End With
       
End Sub

ASKIMS

>>> askims
Det mener jeg nu ikke den gør.
Så vidt jeg kan se medtager den ikke filer i underbiblioteker.
Det er det, som gør min kode så \"tung\".

Men jeg tror da stadig på, at problemet kan løses mere simpelt til Excel97 end min løsning, som jo oprindelig er lavet til Excel95.
Der er sket en væsentlig forbedring af makrosproget fra 95 til 97.

....... og dog

Hvis du ændrer \".SearchSubFolders = False\" til \".SearchSubFolders = True\" så medtager din løsning også underbiblioteker!

Jeg vil straks lægge løsningen ind i mit Excel-arkiv med geniale løsninger! Glimrende!