[已解决]Excel提取文件名或文件

jmkite

原贴http://www.excelpx.com/forum.php ... 2&page=1#pid4017177
由于原贴显示已解决问题，可能导致没有人看贴，所以我另起贴，望版主明白，谢谢！
我的环境是Win7+Office2010，点“提取文件名”无用，无法列出文件夹中下所选扩展名的文件名，点“更改文件名”，在没有文件时，也会提示共更改一个文件，只填一个文件名时，无法提取出文件，要两个或以上才行。有那位高手可以修正下程序不，并且提取文件时，我想要复制，不是现在的剪切。谢谢！

最佳答案

月排行榜 / 总排行榜

wanao2008

2016-3-27 16:54

jmkite 发表于 2016-3-25 09:33
谢谢，可以提取文件名了，不过我想提取出来的文件名不要扩展名，研究你的代码，研究不到在那修改，请问如 ...

Sub 提取文件名_单击()
    Dim Fso As Object, Drive As Object
    Dim Fn As String, Fname As Object, Num As Integer
    Dim subName As String, Disc As String
    subName = [a1]
    Disc = [a2]
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set folder = Fso.GetFolder(Disc)
    For Each Fname In folder.Files
        Fn = Fname.Name
        If Fn Like "*." & subName Then
            Num = Num + 1
            Cells(Num + 3, 1) = Split(Fn, ".")(0)
        End If
    Next
End Sub

跳转到最佳答案楼层

wanao2008

可以用：CreateObject("Scripting.FileSystemObject") 方法 或 DIR 文件，我给你试试

wanao2008

Sub 提取文件名_单击()
    Dim Fso As Object, Drive As Object
    Dim Fn As String, Fname As Object, Num As Integer
    Dim subName As String, Disc As String
    subName = [a1]
    Disc = [a2]
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set folder = Fso.GetFolder(Disc)
    For Each Fname In folder.Files
        Fn = Fname.Name
        If Fn Like "*." & subName Then
            Num = Num + 1
            Cells(Num + 4, 1) = Fn
        End If
    Next
End Sub

jmkite

wanao2008 发表于 2016-3-24 20:54
Sub 提取文件名_单击()
    Dim Fso As Object, Drive As Object
    Dim Fn As String, Fname As Object ...

谢谢，可以提取文件名了，不过我想提取出来的文件名不要扩展名，研究你的代码，研究不到在那修改，请问如何修改。提取出来后的文件名从A5开始列出，我想从A4开始列出。

jmkite

wanao2008 发表于 2016-3-24 20:54
Sub 提取文件名_单击()
    Dim Fso As Object, Drive As Object
    Dim Fn As String, Fname As Object ...

还有一楼中的第二个问题，我也研究不出如何修改这个小Bug,本人初学，请多多指教。

wanao2008

jmkite 发表于 2016-3-25 09:33
谢谢，可以提取文件名了，不过我想提取出来的文件名不要扩展名，研究你的代码，研究不到在那修改，请问如 ...

Sub 提取文件名_单击()
    Dim Fso As Object, Drive As Object
    Dim Fn As String, Fname As Object, Num As Integer
    Dim subName As String, Disc As String
    subName = [a1]
    Disc = [a2]
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set folder = Fso.GetFolder(Disc)
    For Each Fname In folder.Files
        Fn = Fname.Name
        If Fn Like "*." & subName Then
            Num = Num + 1
            Cells(Num + 3, 1) = Split(Fn, ".")(0)
        End If
    Next
End Sub