写一段VBA宏,目的是分析ORG_FILES文件夹里的文件,将文件名有2位字母加10数字相同字符的文件分批复制到NEW_FILES下新建同一个文件夹里,这个文件夹用文件含相同的12位字母加数字命名. 2位字母加10位数字的格式有3中:DA加10位数字,DZ加10位数字,MP加10位数字 ORG_FILES 文件夹位置:C:\Users\DELL\Desktop\ZTE FILE\ORG_FILES NEW_FILES文件夹位置:C:\Users\DELL\Desktop\ZTE FILE\NEW_FILES ZTE DOC表格文件位置:C:\Users\DELL\Desktop\ZTE FILE
时间: 2023-07-21 10:20:28 浏览: 97
以下是可以实现上述功能的VBA宏:
```
Sub CopyFiles()
Dim orgFolder As String, newFolder As String
Dim orgFile As String, newFile As String
Dim fileName As String, fileExt As String
Dim filePattern As String, folderPattern As String
Dim fileCount As Integer, folderCount As Integer
'设置文件夹路径和文件名格式
orgFolder = "C:\Users\DELL\Desktop\ZTE FILE\ORG_FILES\"
newFolder = "C:\Users\DELL\Desktop\ZTE FILE\NEW_FILES\"
filePattern = "[D][A|Z|M][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*"
folderPattern = "[D][A|Z|M][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]"
'检查新文件夹是否存在,不存在则创建
If Dir(newFolder, vbDirectory) = "" Then
MkDir newFolder
End If
'遍历原文件夹中的文件
orgFile = Dir(orgFolder & filePattern)
Do While orgFile <> ""
'提取文件名和扩展名
fileName = Left(orgFile, Len(orgFile) - 4)
fileExt = Right(orgFile, 4)
'检查文件名是否符合要求
If Left(fileName, 2) = "DA" Or Left(fileName, 2) = "DZ" Or Left(fileName, 2) = "MP" Then
'复制文件到新文件夹中
newFile = newFolder & Left(fileName, 12) & fileExt
FileCopy orgFolder & orgFile, newFile
'更新计数器
fileCount = fileCount + 1
'检查是否需要创建新的文件夹
If Dir(newFolder & Left(fileName, 12), vbDirectory) = "" Then
MkDir newFolder & Left(fileName, 12)
folderCount = folderCount + 1
End If
End If
'继续遍历下一个文件
orgFile = Dir()
Loop
'显示处理结果
MsgBox "共复制 " & fileCount & " 个文件到 " & folderCount & " 个文件夹中。"
End Sub
```
使用方法:
1. 打开Excel软件,并创建一个新的工作簿;
2. 在工作簿中按下Alt + F11键,打开VBA编辑器;
3. 在VBA编辑器中,选择菜单栏中的“插入”->“模块”,在新建的模块中复制以上代码;
4. 修改代码中的文件夹路径和文件名格式,以便适应您的需求;
5. 按下F5键运行宏,等待程序运行完毕即可。
注意事项:
1. 确保文件夹路径中的“\”符号使用了两个,或者使用单个“/”符号;
2. 请在运行宏前备份好您的文件,以防出现意外情况;
3. 请确保您的文件名符合要求,否则可能无法复制到新文件夹中。
阅读全文