Excel File Dialog for Selecting File-Paths to Worksheet

'*Reference Microsoft scripting Runtime    http://www.microsoft-programmierer.de/Details?d=1076

Public Sub Select_File()

    '-----------< Select_File() >-----------

    '------< Select_File() >------

    '--< File-Dialog >--

    Dim objFiledialog As FileDialog

    Set objFiledialog = Application.FileDialog(msoFileDialogFilePicker)

    objFiledialog.AllowMultiSelect = True

    objFiledialog.ButtonName = "->Select Files"

    objFiledialog.Filters.Add "Add Files", "*.*"

    objFiledialog.Title = "Select Files.."

    objFiledialog.InitialView = msoFileDialogViewTiles

    objFiledialog.InitialFileName = ActiveWorkbook.Path

    objFiledialog.AllowMultiSelect = True

    If Not objFiledialog.Show() = True Then

        Exit Sub

    End If

    '--< File-Dialog >--

    '-< check >-

    '</ Ordner ist leer >

    If objFiledialog.SelectedItems().Count = 0 Then

        Exit Sub

    End If

    '</ Ordner ist leer >

    '-</ check >-

    Dim sFilename As String

    Dim sFiles As String

    sFiles = ""

    '----< @Loop: Files >----

    Dim iFile As Integer

    For iFile = 1 To objFiledialog.SelectedItems.Count

        '------< Loop.Item  >------

        DoEvents

        '< get selection >

        sFilename = objFiledialog.SelectedItems(iFile)

        '</ get selection >

        '< correct >

        sFilename = Replace(sFilename, ActiveWorkbook.Path & "\", "", 1, 1, vbBinaryCompare)

        '</ correct >

        '< add >

        sFiles = sFiles & ";" & sFilename

        '</ add >

    Next

    '----</ @Loop: Files >----

    '< correct >

    sFiles = Replace(sFiles, ";", "", 1, 1, vbBinaryCompare)

    '</ correct >

    '< write_into_cell >

    ActiveWorkbook.Names("varFiles").RefersToRange.Value2 = sFiles

    '</ write_into_cell >

    '-----------</ Select_File() >-----------

End Sub