Prøv f. eks. denne version:
Option Explicit
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Function qfil_GetAllFileNamesInDirectory(strDirectoryName As String)
'declarations
Dim ra() As String
Dim objDirectory As Variant
Dim objFile As Variant
Dim intNumberOfFiles As Integer
Dim strFileName As String
Dim intIndex As Integer
'variables
Set objDirectory = qfil_GetDirectory(strDirectoryName)
intNumberOfFiles = objDirectory.Files.Count
ReDim Preserve ra(intNumberOfFiles)
'run through and get pathAndFileNames
intIndex = 0
For Each objFile In objDirectory.Files
'variables
strFileName = objFile.Name
'assign it
ra(intIndex) = strFileName
'increment
intIndex = intIndex + 1
Next
qfil_GetAllFileNamesInDirectory = ra
End Function
'method: get directory object
Function qfil_GetDirectory(strDirectoryName As String)
'declarations
Dim objFSO As Variant
Dim objDirectory As Variant
'variables
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDirectory = objFSO.GetFolder(strDirectoryName)
Set qfil_GetDirectory = objDirectory
End Function
Sub Knap4_Klik()
Dim fs, f, fn, Files As Variant, i As Integer, fp As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(BrowseForFolder())
MsgBox (f.Path)
fp = f.Path
Files = qfil_GetAllFileNamesInDirectory(fp)
MsgBox (Files(1))
i = 2 'Start row
For Each fn In Files
Worksheets("Ark1").Cells(i, "A") = fn
i = i + 1
Next
End Sub