代码之家 › 专栏 › 技术社区 › sifar

自动选择并突出显示应用程序中选定文件夹中的所有文件。FileDialog(msoFileDialogFilePicker)

filedialog highlight select vba excel

sifar · 技术社区 · 1 年前

我正在使用 Application.FileDialog(msoFileDialogFilePicker) 并导航到任何特定文件夹以自动选择(并在可能的情况下突出显示)该文件夹中的所有文件,填充 Filename 文本框在 Application.FileDialog 如下所示(这里我只手动选择了2个文件来填充文件名文本框:

我试过:

Sub SelectAllFilesInFolder()
Dim fd As FileDialog
Dim vSelectedItems As Variant
Const sPath As String = "C:\Users\somefolder\"
Dim sFileString As Variant
Dim vFiles As Variant
Dim FileColl As Collection

With ThisWorkbook
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = True
        .Filters.Add "Word Files", "*.doc*", 1
        .InitialFileName = sPath
        .ButtonName = "Select"
        sFileString = sPath & Chr(31) & "France - Charlotte.docx" & Chr(31) & " " & Chr(31) & "France - Fabienne.docx" & Chr(31)
        .InitialFileName = sFileString
                
        If .Show = -1 Then
           ' some processing code    
        End If
        
    End With

End With
End Sub

然而, initialFilename 未填充 filename 文本框。即使我在其中手动输入以下字符串,单击“打开”按钮时也会出错。

"France - Charlotte.docx" "France - Fabienne.docx"

当用户手动选择文件夹中的文件时,填充的字符串似乎有所不同。如何实现自动化?

0 回复 | 直到 1 年前

Noam Brand 1 年前

此VBA是一种解决方法,允许用户选择一个文件夹,然后将与特定名称匹配的文件从所选文件夹复制到临时目录。在查看临时目录中的文件后,系统会提示用户离开临时目录或删除它。我不明白将目录中的所有文件而不仅仅是其中的一部分放在高位的意义。

之所以选择将文件复制到临时目录的方法,是因为使用 explorer /select 命令不能直接用于多个文件。

我认为这种方法提供了一种隔离和显示感兴趣文件的干净方法。此外,通过为用户提供在查看后删除临时目录的选项,我们确保不会无意中用剩余的文件和文件夹弄乱他们的文件系统。

Sub selectedFilescopy2TempFolder()
    Dim strFolderPath As String
    Dim searchStrings() As String
    Dim tempDir As String
    Dim fileName As String
    Dim fileWithoutExtension As String
    Dim i As Integer
    Dim matchedFiles() As String
    Dim matchedFileCount As Integer
    Dim FSO As Object
    Dim userResponse As VbMsgBoxResult

    searchStrings = Split("1111,googleTranslate2,AnotherName", ",")

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            strFolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    tempDir = strFolderPath & "\TempSelectDir"
    If Not FSO.FolderExists(tempDir) Then
        FSO.CreateFolder(tempDir)
    End If

    fileName = Dir(strFolderPath & "\*.*")
    Do While fileName <> ""
        
        fileWithoutExtension = Left(fileName, InStrRev(fileName, ".") - 1)
        
        For i = LBound(searchStrings) To UBound(searchStrings)
            If fileWithoutExtension = searchStrings(i) Then
                FSO.CopyFile strFolderPath & "\" & fileName, tempDir & "\" & fileName
                
                matchedFileCount = matchedFileCount + 1
                ReDim Preserve matchedFiles(1 To matchedFileCount)
                matchedFiles(matchedFileCount) = fileName
            End If
        Next i
        
        fileName = Dir
    Loop

    If matchedFileCount > 0 Then
        Shell "explorer " & tempDir, vbNormalFocus
        userResponse = MsgBox("If you wish to leave the folder as is, press OK. If you want to delete the folder, press Cancel.", vbOKCancel + vbQuestion)

        If userResponse = vbCancel Then
            For i = 1 To matchedFileCount
                FSO.DeleteFile tempDir & "\" & matchedFiles(i)
            Next i
            FSO.DeleteFolder tempDir
        End If

    Else
        MsgBox "No matching files found.", vbInformation
    End If

    Set FSO = Nothing
End Sub