这个获取文件名，能否改成word版本

菜菜行者

在坛里搜索了一圈，找到excel版本的，代码如下，想在word使用，能否改成word版本使用。

Sub test()
    Dim folder As Object, filepath$, filename$, i%
    i = 1
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    With folder
        If .Show = -1 Then
            filepath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    filename = Dir(filepath & "\*.*")
    Do
    Cells(i, 1) = Left(filename, InStrRev(filename, ".") - 1)
    i = i + 1
    filename = Dir
    Loop Until filename = ""
End Sub

zyg365

Sub test()
    Dim folder As Object, filepath$, filename$, i%
    i = 1
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    With folder
        If .Show = -1 Then
            filepath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    filename = Dir(filepath & "\*.*")
    Do
    MsgBox Left(filename, InStrRev(filename, ".") - 1)
    i = i + 1
    filename = Dir
    Loop Until filename = ""
End Sub

菜菜行者

zyg365 发表于 2017-5-22 15:06
Sub test()
    Dim folder As Object, filepath$, filename$, i%
    i = 1

获取到的文档都以msgbox窗口来显示，用处不大。
应该能贴到word文档中，可以自动新建一个文档。

duquancai

Sub test()
    Dim doc As Document, fol As Object, sr$
    Set doc = ActiveDocument
    Set fol = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
    If Not fol Is Nothing Then pa$ = fol.Items.Item.Path Else MsgBox "请选目标文件夹": Exit Sub
    f$ = Dir(pa & "\*.*")
    Do While f <> ""
        n = n + 1: sr = pa & f
        k = k & n & "、" & Left(sr, InStrRev(sr, ".") - 1) & Chr$(13)
        f = Dir
    Loop
    doc.Content.Text = Empty
    doc.Content.Text = k
    MsgBox "已提取：" & n & "个包含选择路径下的所有文件！"
End Sub

菜菜行者

duquancai 发表于 2017-5-22 15:56
Sub test()
    Dim doc As Document, fol As Object, sr$
    Set doc = ActiveDocument

感谢杜老师再次出手相助。
当运用你的代码后，知道还能获取到路径，是否也能获到子目录下所有文件呢

菜菜行者

zyg365 发表于 2017-5-22 15:06
Sub test()
    Dim folder As Object, filepath$, filename$, i%
    i = 1

只是弹出msgbox窗口，这样没办法复制文件名啊

duquancai

菜菜行者 发表于 2017-5-22 16:07
感谢杜老师再次出手相助。
当运用你的代码后，知道还能获取到路径，是否也能获到子目录下所有文件呢

答案是肯定的，请移步到下面链接：
http://club.excelhome.net/thread-1185089-1-1.html

菜菜行者

duquancai 发表于 2017-5-22 16:13
答案是肯定的，请移步到下面链接：
http://club.excelhome.net/thread-1185089-1-1.html

好的，谢谢

小花鹿

这个问题的代码是通用的吧，与EXCEL和WORD有关系吗？

13907933959

duquancai 发表于 2017-5-22 15:56
Sub test()
    Dim doc As Document, fol As Object, sr$
    Set doc = ActiveDocument

杜前辈好！
能不能劳您给一个提取多层文件夹内所有文件名的代码？在“选择文件夹”时，也能包括电脑桌面上的文件夹，谢谢！