|
'*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
|