GetFileName_Multiple Files

[marcusmark]

Hi,
I need help in editing the codes I used as below:

Sub GetImportFileName2()
Dim FileNames As Variant
Dim Msg As String
Dim I As Integer
FileNames = Application.GetOpenFilename _
(MultiSelect:=True)
If IsArray(FileNames) Then
'Display full path and name of the files
'Msg = "You selected:" & vbNewLine
For I = LBound(FileNames) To UBound(FileNames)
Msg = Msg & FileNames(I) & vbNewLine
Range("A1") = Msg
Next I
MsgBox Msg
Else
'Cancel button clicked
MsgBox "No files were selected."
End If
End Sub

Its a code for GETOPENFILENAME with mutiple selection.
My problem is that I want the filenames only, not the whole path, just the name of the files and it is not only to be copied to a single range. Its like if I choose, 3 files, then 1st file would be in Cell A1, 2nd file in Cell A2 and so on.

Thanks in advance!

 

[ranman256]

This will load files W/O dir name...

   'import all files in folder
'------------------
Public Sub ImportSomeFileNamesInDir()
'------------------
Dim vFil, vTargT, vDir, vPath
Dim i As Integer
Dim sTbl As String, sSql As String
Dim colFiles As FileDialogSelectedItems
Dim itm


On Error GoTo errImp


Set colFiles = UserPickFiles("*.xls", "")
If colFiles.Count > 0 Then
   vPath = colFiles(1)
   getDirName vPath, vDir, vFil
    
       'post the folder name
   'Range("A1").Select
   'ActiveCell.Value = vDir
   'ActiveCell.Offset(1, 0).Select
    
    
       'post the filenames w/o folder name
    i = Len(vDir)
    Range("A1").Select
    For Each itm In colFiles
            vFil = Mid(itm, i + 1) 'filename sans directory
            ActiveCell.Value = vFil
            
            ActiveCell.Offset(1, 0).Select
    Next
End If


Set colFiles = Nothing
Exit Sub

errImp:
MsgBox Err.Description, vbCritical, "ImportAllXLFilesAndSheets()" & Err
Exit Sub
Resume
End Sub


'------------------
Private Function UserPickFiles(ByVal pvFilter, Optional pvStartPath) As FileDialogSelectedItems
'------------------
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String


With Application.FileDialog(msoFileDialogFilePicker)   'MUST ADD REFERENCE : Microsoft Office xx.0 Object Library
    .InitialFileName = pvStartPath
    .Title = "Locate a files to Import"
    .ButtonName = "Import"
    .Filters.Clear
    .Filters.Add "Filter", pvFilter
    .Filters.Add "All Files", "*.*"
    .InitialFileName = "c:\"
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail
    .AllowMultiSelect = True
    
        If .Show = 0 Then
           'MsgBox "Cancelled", vbCritical, "UserPickFile()"
           Exit Function
        End If
    
    'Save the first file selected
    Set UserPickFiles = .SelectedItems
End With
End Function


'------------------
Private Sub getDirName(ByVal psFilePath, ByRef prvDir, Optional ByRef prvFile)
'------------------
    'psFilePath: full file path given
    'prvDir : directory name output
    'prvFile: filename only output
Dim i As Integer, sDir As String


i = InStrRev(psFilePath, "\")          'not available in '97
If i > 0 Then
  prvDir = Left$(psFilePath, i)
  prvFile = Mid$(psFilePath, i + 1)
  If Asc(Mid(prvFile, Len(prvFile), 1)) = 0 Then prvFile = Left(prvFile, Len(prvFile) - 1)
End If
End Sub

 

[marcusmark]

wow.this is what I really need though the codes are quite of different level (not that user-friendly to me. Hahaha) but will just study each code.thanks a lot! Super!