获取特定单元格中的文件名

时间:2017-04-11 10:16:45

标签: vba filenames

有没有办法使用VBA我们可以运行一个窗口选择一个文件,当我们点击它时,名称应该被复制而没有它的扩展名(.txt),应该被复制到sheet" TEXT" ,细胞AZ2。

我开始使用一些代码,但它不起作用。不知道该怎么做。

Sub Main_Macro()
Dim fName As String, LastRowim As Long

fName = Application.GetOpenFilename("Text Files (*.txt), *.adt")
If fName = "False" Then Exit Sub

End Sub

2 个答案:

答案 0 :(得分:0)

尝试使用GetBaseName()方法获取没有扩展名的文件名。

答案 1 :(得分:0)

这样的事情怎么样:

Sub foo()
    Dim fd As FileDialog
    Dim fName As String  ' Includes full path
    Dim fChosen As Integer
    Dim fNameFile As String  'Only the name of the file

    Set fd = Application.FileDialog(msoFileDialogFilePicker) 'open dialog box
            fd.Title = "Please select file" 'dialog Title
            fd.InitialFileName = "C:\Users\" 'Path to initiate Dialog box
            'fd.InitialFileName = ThisWorkbook.Path & "\" 'alternate initial path
            fChosen = fd.Show
                    fd.Filters.Clear
                    'fd.Filters.Add "CSV files", "*.csv" 'add filters to only show this type of file
                    fd.Filters.Add "Text files", "*.txt" 'in this case only txt files will be selectable

         If fChosen <> -1 Then
             MsgBox "You Cancelled, nothing done!", vbInformation
         Else
            fName = Right$(fd.SelectedItems(1), Len(fd.SelectedItems(1)) - InStrRev(fd.SelectedItems(1), "\")) 'get full path of file, then remove anything prior to \ to get filename
            Position = InStr(fName, ".") 'get the position of the extension
            If Position > 0 Then Extension = Right(fName, Len(fName) - Position + 1) 'get the actual extension of the file
            fName = Replace(fName, Extension, "") 'remove that extenstion
            Sheets("TEXT").Range("AZ2").Value = fName 'enter the file name to your chosen range
        End If
End Sub