遍历文件夹与子文件夹给文件加标题

wenwen000424 · 发表于 2015-1-3 10:01

首先祝各位新年快乐，一切如意！

通过运行宏，跳出选择文件夹窗口选择文件夹，遍历所选取文件夹和该文件夹中的所有子文件夹里的文件并加入标题。标题样式见示例文件夹中的文件标题。

求助.rar (89.32 KB, 下载次数: 22)

liulang0808 · 发表于 2015-1-3 10:24

http://club.excelhome.net/thread-1165866-1-1.html

这个有遍历的内容，供参考吧。。。。

wenwen000424 · 发表于 2015-1-3 10:39

liulang0808 发表于 2015-1-3 10:24
http://club.excelhome.net/thread-1165866-1-1.html

这个有遍历的内容，供参考吧。。。。

谢谢您的关注，我这个除了遍历外还要加标题，对于我有难度。

liulang0808 · 发表于 2015-1-3 10:42

wenwen000424 发表于 2015-1-3 10:39
谢谢您的关注，我这个除了遍历外还要加标题，对于我有难度。

加标题，可以先打开文件，增加标题，保存文件
这几个步骤不难的，只要遍历到文件就好说了

wenwen000424 · 发表于 2015-1-3 11:05

liulang0808 发表于 2015-1-3 10:42
加标题，可以先打开文件，增加标题，保存文件
这几个步骤不难的，只要遍历到文件就好说了

我已经折腾了一些时间，没有成功，所以来请教高手了，能否帮助一下？先谢了！

liulang0808 · 发表于 2015-1-3 11:27

wenwen000424 发表于 2015-1-3 11:05
我已经折腾了一些时间，没有成功，所以来请教高手了，能否帮助一下？先谢了！

标题规范是什么啊

zhaogang1960 · 发表于 2015-1-3 11:35

请参考：

Sub Macro1()
Dim Fso As Object, Folder As Object, arr$(), m&, i&, p$, wf As WorksheetFunction
p = ThisWorkbook.Path
Set wf = WorksheetFunction
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(p)
Application.ScreenUpdating = False
Call GetFiles(Folder, arr, m)
For i = 1 To m
With Workbooks.Open(arr(1, i))
With .Worksheets(1)
If wf.CountA(.Rows("1:1")) > 1 Then Rows("1:1").Insert Shift:=xlDown
.Range("a1").Value = wf.Text(Replace(arr(2, i), ".xls", ""), "0000年00") & "月份" & Split(Replace(arr(1, i), p, ""), "")(1) & "表"
End With
.Close 1
End With
Next
Application.ScreenUpdating = True
MsgBox "ok"
Set Folder = Nothing
Set Fso = Nothing
End Sub
Sub GetFiles(ByVal Folder As Object, arr$(), m&)
Dim SubFolder As Object
Dim File As Object
If Folder.Path <> ThisWorkbook.Path Then
For Each File In Folder.Files
If File.Name Like "*.xls" Then
m = m + 1
ReDim Preserve arr(1 To 2, 1 To m)
arr(1, m) = File
arr(2, m) = File.Name
End If
Next
End If
For Each SubFolder In Folder.SubFolders
Call GetFiles(SubFolder, arr, m)
Next
End Sub

复制代码

liulang0808 · 发表于 2015-1-3 11:37

Sub 按钮1_Click()

   Set fso = CreateObject("scripting.filesystemobject")
   fd = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & "\"
   If Not fso.folderexists(fd) Then Exit Sub
   Application.ScreenUpdating = False
   Getfd (fd)
   Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
   Set fso = CreateObject("scripting.filesystemobject")
   Set ff = fso.getfolder(pth)
   For Each f In ff.Files
      Set wb = Workbooks.Open(f)
      wb.Sheets(1).Rows(1).Insert
      wb.Sheets(1).Cells(1, 1) = Left(f.Name, 4) & "年" & Mid(f.Name, 5, 2) & "月" & "10日工资"
      wb.Save
      wb.Close
   Next f
   For Each fd In ff.subfolders
      Getfd (fd)
   Next fd
End Sub

zhaogang1960 · 发表于 2015-1-3 11:38

本帖最后由 zhaogang1960 于 2015-1-3 11:43 编辑

请测试附件

求助.rar (58.41 KB, 下载次数: 56)

liulang0808 · 发表于 2015-1-3 11:38

这次看看是否满足需求吧，具体添加标题内容，自己可以根据需求修改的

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

[求助] 遍历文件夹与子文件夹给文件加标题

评分