[已解决]历遍文件夹提取除打开文件的所有.xls文件名

love_liwu · 发表于 2015-7-24 21:46

本帖最后由 love_liwu 于 2015-7-27 22:41 编辑

老师，您好，我有以下问题麻烦帮我看看，谢谢。
问题一：优化以下代码：
Sub 分列()
'
' 分列 Macro
' 宏由 zhendeaini 录制，时间: 2015-7-24
'
Application.ScreenUpdating = False
Sheet2.Activate
Columns("B:F").ClearContents
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
      Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
      :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
      1), Array(6, 1)), TrailingMinusNumbers:=True
Sheet2.[A1].Select
'Application.ScreenUpdating = True
End Sub
这是录制宏，能否优化下代码。
问题二：
我写了这样的代码，可以历遍文件夹内文件并提取所有.xls文件名称。现在问题是提取的文件名包括了现在打开的demo工作簿的名称，我想提取的名称中去除打开的文件名（不包含demo.xls）。怎么处理。
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheet2.Columns("A:F").ClearContents
Dim a As FileSearch '定义一个文件搜索对象
Set a = Application.FileSearch
a.LookIn = ThisWorkbook.Path & "\" '搜索当前文件夹
a.Filename = "*.xlt;*.xls;*.xlsx"  '搜索所有文件
'a.SearchSubFolders = True '设置是否搜索子文件夹
a.Execute '执行搜索
Sheet2.Activate
For i = 1 To a.FoundFiles.Count
Cells(i, 1) = a.FoundFiles(i) '第一列填写文件名
Next
Call 分列
Sheet1.Activate
Application.ScreenUpdating = True
End Sub

历遍文件夹提取除打开文件的所有.xls文件名.zip (12.04 KB, 下载次数: 4)

grf1973 · 发表于 2015-7-27 09:42

问题2看看这样对不对

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheet2.Columns("A:F").ClearContents
Dim a As FileSearch '定义一个文件搜索对象
Set a = Application.FileSearch
a.LookIn = ThisWorkbook.Path & "" '搜索当前文件夹
a.Filename = "*.xlt;*.xls;*.xlsx" '搜索所有文件
'a.SearchSubFolders = True '设置是否搜索子文件夹
a.Execute '执行搜索
Sheet2.Activate
For i = 1 To a.FoundFiles.Count
[color=Red]If InStr(a.FoundFiles(i), ThisWorkbook.Name) = 0 Then
Cells(i, 1) = a.FoundFiles(i) '第一列填写文件名
End If[/color]
Next
Call 分列
Sheet1.Activate
Application.ScreenUpdating = True
End Sub

复制代码

grf1973 · 发表于 2015-7-27 09:43

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheet2.Columns("A:F").ClearContents
Dim a As FileSearch '定义一个文件搜索对象
Set a = Application.FileSearch
a.LookIn = ThisWorkbook.Path & "" '搜索当前文件夹
a.Filename = "*.xlt;*.xls;*.xlsx" '搜索所有文件
'a.SearchSubFolders = True '设置是否搜索子文件夹
a.Execute '执行搜索
Sheet2.Activate
For i = 1 To a.FoundFiles.Count
If InStr(a.FoundFiles(i), ThisWorkbook.Name) = 0 Then
Cells(i, 1) = a.FoundFiles(i) '第一列填写文件名
End If
Next
Call 分列
Sheet1.Activate
Application.ScreenUpdating = True
End Sub

复制代码

love_liwu · 发表于 2015-7-27 10:19

本帖最后由 love_liwu 于 2015-7-27 10:27 编辑

grf1973 发表于 2015-7-27 09:43

测试了一下，代码不够完善哦。当我打开顾客信息表另存为其他名称时候，再打开操作表是无法找到的。您看看。

我想那个操作表就不搜寻了，就算是搜寻到了也不排列，后续找到的就占着操作表的位置。简单地说，有三个exce，假设其中操作表按搜寻位置排第二，我现在要在sheet2排列顺序如下：ggsheet1，顾客信息，这里顾客信息就取代操作表的位置。

高山之岫 · 发表于 2015-7-27 10:59

我来看看

love_liwu · 发表于 2015-7-27 22:40

grf1973 发表于 2015-7-27 09:43

谢谢老师。同样用您的代码，不过我换过个思路了。问题解决了，再次感谢老师。您帮我很多忙了。

		自动登录	找回密码
密码			注册

[已解决]历遍文件夹提取除打开文件的所有.xls文件名

相关帖子