请求各位高手帮我写个VBA代码，完成重复性很高的文件处理。

hjb_xy

在“E:\2024年扫描\临时文件夹”下，有命名为以1开始的文件夹若干（最大999），同时在临时文件夹下，还有与以同样命名方式命名且数量相等的PDF文件。

现需要VBA实现：

1、将文件1.PDF复制到1文件夹内，同时将自制进去的1.PDF重命名为：2024年扫描.PDF。以此类推，将所有PDF文件复制到同名的文件夹内，并都重命名为“2024年扫描.PDF”同样的文件名。

2、工作表sheet3中有数据：A列为1向下填充，到临时文件夹下以数字命名的文件夹数量为止，B列有对应的数据。现需要在完成第一个需要后，将临时文件夹以数字命名的文件夹，重命名为A列对应的B列数据。

ykcbf1100

没有附件，估计下手的人不会多。

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=73cffde5
链接内容供参考。。。。。。

3190496160

求助务必上传附件，才可能得到别人的帮助

悠扬的旋律

类似 供参考

1. Sub S20240601_095110_文件夹新建文件移动_Macro1()
   
2.    
   
3.     文件对象 fso
   
4.    
   
5.     路径1 = "C:\Users\Administrator\Desktop\新建文件夹\1"
   
6.     路径2 = "C:\Users\Administrator\Desktop\新建文件夹\2"
   
7.    
   
8.     文件夹复制 fso, 路径1, 路径2
   
9.    
   
10.     '================================================================
    
11.    
    
12.     文件 路径2, 数组
    
13.     筛选 数组, 1, 2, "*.xls*"
    
14.     '数组到单元格 数组, [A1]
    
15.    
    
16.     '================================================================
    
17.    
    
18.     For 第几行 = 1 To UBound(数组, 1) Step 1
    
19.         
    
20.         文件夹路径 = 数组(第几行, 1)
    
21.         'C:\Users\Administrator\Desktop\新建文件夹\2
    
22.         
    
23.         文件名 = 数组(第几行, 2)
    
24.         '新建 XLS 工作表.xls
    
25.         
    
26.         文件名去掉后缀 = Split(文件名, ".")(0)
    
27.         
    
28.         文件路径_旧 = 文件夹路径 & "" & 文件名
    
29.         '"C:\Users\Administrator\Desktop\新建文件夹\2\新建 XLS 工作表.xls"
    
30.         
    
31.         文件夹路径_新 = 文件夹路径 & "" & 文件名去掉后缀
    
32.         文件夹判断 fso, 文件夹路径_新, 返回值
    
33.         If 返回值 = "存在" Then
    
34.             
    
35.         Else
    
36.             文件夹新建 fso, 文件夹路径_新
    
37.         End If
    
38.         
    
39.         文件路径_新 = 文件夹路径_新 & "" & 文件名
    
40.         '"C:\Users\Administrator\Desktop\新建文件夹\2\新建 XLS 工作表\新建 XLS 工作表.xls"
    
41.         
    
42.         返回 = MoveFile(lpExistingFileName:=文件路径_旧, lpNewFileName:=文件路径_新)
    
43.         
    
44.     Next
    
45.    
    
46. End Sub

复制代码

hjb_xy

我参照网一些高手写的代码，写了以下两个宏，利用Sheet2作为辅助表格，基本能完成大部分工作。



Sub 新建编号文件夹() '文件夹名为数字

A = Application.InputBox("请输入起始文件夹编号", , 1, , , , , 1)
B = Application.InputBox("请输入结束文件夹编号", , 999, , , , , 1)
For N = A To B
MkDir "E:\2024年扫描\临时文件夹\" & N
Next N
End Sub


Sub 复制文件到同名文件夹内并重命名为F列名称()  '批量获取文件夹内文件名并移动动文件并重命名
    Dim folderPath As String
    Dim fileName As String
    Dim i As Integer
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim k As String
   
    ' 设置文件夹路径
    folderPath = "E:\2024年扫描\临时文件夹" ' 设置文件夹路径
        i = 1 ' 初始化变量
        Set fso = CreateObject("Scripting.FileSystemObject") ' 创建FileSystemObject对象
        Set folder = fso.GetFolder(folderPath) ' 获取文件夹对象
    Sheet2.Select
        Range("A1:A" & Rows.Count).ClearContents ' 清空目标单元格区域
    'Cells(i, 2) = fso.GetFolder(folderPath)  无用
         For Each file In folder.Files  ' 遍历文件夹内的文件
            fileName = file.Name    ' 获取文件名称
           Cells(i, 1).Value = fileName     ' 将文件名输出到单元格
                Cells(i, 5).Value = folder & "\" & fileName '在E列对应单元格列出旧文件的路径及文件名
             k = folder & "\" & Cells(i, 2).Value & "\" & Cells(i, 6).Value & ".pdf" '在F列对应单元格列出新文件的路径及新文件,新文件名要提前在F列输入。
        FileCopy folder & "\" & fileName, k '复制旧文件为新文件
        i = i + 1 ' 移动到下一行
    Next file
   
    ' 清理对象
    Set file = Nothing
    Set folder = Nothing
    Set fso = Nothing
End Sub

大灰狼1976

'假设有1-10命名的pdf，同路径下10个对应的文件夹已存在，移动文件
Sub test()
Dim s$, n&
s = "E:\2024年扫描\临时文件夹\"
For n = 1 To 10
  Name s & n & ".pdf" As s & n & "\2024年扫描.PDF"
Next
End Sub