The following Excel macro code in vba creates a file dialog for an Excel file.
Several files can be selected and adopted as text.
Download: The code template is available for download under Codedocu.de as Excel sample file.
or: The vba code sample can be copied as vba code below.
In the file dialog
By clicking on the button: -> Select Files
Vba code to paste into the Excel file
'*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
|