Excel单元格自动打开/关闭文件窗口，并将文件名和路径作为单元格值

Question

I am newbie in Excel. I need to something like below.

When user click on a cell or enter to cell:

1. It should automatically open/close file window.

2. When user select a file, it should pick up path/filename and put into the cell, like c:\\folder1\\file1.ext

3. If user select more than one file, it should pick up all path/filenames into cell,with | as delimiter. like c:\\folder1\\file1.ext|d:\\folder2\\file2.ext

4. If user click on a cell or enter to cell for a second time, it should keeps existing path/filenames and let to add other path/filnames to them like in number 3

Answer 1

This is similar to Sid's, just lets you double click any single cell to open the file dialog.

In a Module

Public Function getList(Optional ByVal Target As Range = Nothing) As String
Dim Dialog As FileDialog
Dim File As Integer
Dim Index As Integer

Dim List() As String
Dim Item As Integer
Dim Skip As Boolean

Set Dialog = Application.FileDialog(msoFileDialogFilePicker)

File = Dialog.Show

If File = -1 Then
    ' Get a list of any pre-existing files and clear the cell
    If Not Target Is Nothing Then
        List = Split(Target.Value, "|")
        Target.Value = ""
    End If
    ' Loop through all selected files, checking them against any pre-existing ones to prevent duplicates
    For Index = 1 To Dialog.SelectedItems.Count
        Skip = False
        For Item = LBound(List) To UBound(List)
            If List(Item) = Dialog.SelectedItems(Index) Then
                Skip = True
                Exit For
            End If
        Next Item
        If Skip = False Then
            If Result = "" Then
                Result = Dialog.SelectedItems(Index)
            Else
                Result = Result & "|" & Dialog.SelectedItems(Index)
            End If
        End If
    Next Index
    ' Loop through the pre-existing files and add them to the result
    For Item = UBound(List) To LBound(List) Step -1
        If Not List(Item) = "" Then
            If Result = "" Then
                Result = List(Item)
            Else
                Result = List(Item) & "|" & Result
            End If
        End If
    Next Item
    Set Dialog = Nothing
    ' Set the target output if specified
    If Not Target Is Nothing Then
        Target.Value = Result
    End If
    ' Return the string result
    getList = Result

End If
End Function

In Your Worksheet's Code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then getList Target
End Sub

Update I've changed the getList function (it wasn't broken, just made it do more)

• It will allow you to double click any cell, which will open a file dialog.
• You can select 1 (or more) files
• The file names will be joined with the "|" character and put in the target cell
• If any pre-existing files are in the cell, the new ones will be appended to them

It does not however support pressing enter to open the file dialog, you must double-click the cell.

Update To help VMO (commenter)

The code in the worksheet module:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Address = "$A$1" Then ' See Notes Below
            Target.Value = getList(Target)
        End If
    End If
End Sub

To restrict what cell(s) are double-click'able you will need to use something like that. You can change $A$1 to whatever you want or find a way to determine the target range's name (not too difficult)

If your worksheet is not locked the cell that is clicked will keep focus, and be in edit-mode which is a little annoying. Locking the cell, in previous versions of excel fixed this (i think it doesn't work in v.2010+ though)

The code in the module (getList) can remain almost exactly the same (although you might want to remove all the code that deals with multiple files, not required though). All you need to do is add one line of code.

.......
Dim Skip As Boolean

Set Dialog = Application.FileDialog(msoFileDialogFilePicker)

Dialog.AllowMultiSelect = False ' This will restrict the dialogue to a single result

File = Dialog.Show

If File = -1 Then
......

Hope this helps and I've understood what you were asking!

Answer 2

This should do the trick. The first subroutine is the event that is triggered on the user clicking on a cell. Change the row and column numbers in the first if statement to change the target cell. You can put all of this code in the code module for the worksheet you want it to work on.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim filenames() As String
    Dim filename As Variant
    Dim filelist As String

    ' Make sure the user clicked our target cell

    If Target.Row = 2 And Target.Column = 2 Then

        ' Get a list of filenames

        filenames = GetFileNames

        ' Make sure we got some filenames

        If UBound(filenames) > 0 Then

            ' Go through the filenames, adding each to the output string

            For Each filename In filenames
                filelist = filelist & CStr(filename) & "|"
            Next filename

            ' Remove the final delimiter

            filelist = Left(filelist, Len(filelist) - 2)

            ' Apply the output string to the target cell (adding another
            ' delimiter if there is already text in there)

            If Not Target.Value = "" Then
                Target.Value = Target.Value & "|"
            End If

            Target.Value = Target.Value & filelist

        End If

    End If

End Sub

The following function is that which is called to open the file dialogue and retrieve the filenames.

Private Function GetFileNames() As String()

    Dim dlg As FileDialog
    Dim filenames() As String
    Dim i As Integer

    ' Open a file dialogue

    Set dlg = Application.FileDialog(msoFileDialogFilePicker)

    With dlg
        .ButtonName = "Select"                  ' Text of select/open button
        .AllowMultiSelect = True                ' Allows more than one file to be selected
        .Filters.Add "All Files", "*.*", 1      ' File filter
        .Title = "Select file(s)"               ' Title of dialogue
        .InitialView = msoFileDialogViewDetails
        .Show

        ' Redimension the array with the required number of filenames

        ReDim filenames(.SelectedItems.Count)

        ' Add each retrieved filename to the array

        For i = 1 To .SelectedItems.Count
            filenames(i - 1) = .SelectedItems(i)
        Next i

    End With

    ' Clean up and return the array

    Set dlg = Nothing
    GetFileNames = filenames

End Function