|
一、需求
网站下载的一批文件，虽然文件格式显示".xls"，但是与实际格式不匹配，现在需要将他们按照规则存入相应路径下，并且保存为".xlsx"的正确格式。 简单的批量修改名称和存盘用bat命令也能实现，但是由于格式需要修改，直接修改文件后缀格式会报错，正常的步骤是通过[打开文件-另存为],因此该代码就要实现自动化另存为的功能。 存盘规则如下：D列是deal name ，例如HLA 11这个deal，11p.xls、11c.xls、11w.xls需要存到路径V:\HLA 11\2019\July 2019下面，它们分别要被命名为Two Way Recon HLA 11 07.03.2019.xlsx Transaction Recon HLA 11 07.03.2019.xlsx Wires Transaction Recon HLA 11 07.03.2019.xlsx
二、实现
Sub savefile_all()
Dim obook As Workbook
Dim nbook As Workbook
For j = 1 To 2/*文件种类*/
For i = 5 To 14/*deal种类*/
/*获取旧文件完整路径文件名*/
old_path = "C:\Users\XXXX\Desktop\position"/*原文件所在路径，如果该宏文件和原文件在同一个文件夹，可以使用获取当前路径的方法ThisWorkbook.Path得到原文件路径*/
old_file_name = Cells(i, j)/*原文件名就是11p.xls这样的，i是列号，j是行号*/
old_name = old_path & "\" & old_file_name/*原文件路径和原文件名组合起来就是原文件的完整路径文件名*/
Set obook = GetObject(old_name)/*old_name只是字符串，GetObject方法将之转换成可使用的对象*/
/*获取新文件完整路径文件名*/
deal_name = Cells(i, 4)/*deal_name都在第4列即D列*/
file_type = Cells(34, j)/*文件种类都在34行*/
new_path = "V:\" & deal_name & "\2019\July 2019"/*新路径是用deal name 拼凑的*/
'new_path = "V:\Inactive Deals\" & deal_name & "\2019\July 2019"/*适用于31-33行的3个deal,没有轮到它们存盘的时候被注释掉，轮到它们的时候打开，也可以写一个逻辑判断代替手动开关*/
sr = Dir(new_path, vbDirectory)/*返回新路径*/
If sr = "" Then MkDir (new_path)/*如果新路径不存在就新建*/
new_file_name = file_type & deal_name & " 07.03.2019.xls"/*拼接新文件名*/
new_name = new_path & "\" & new_file_name/*拼接新文件完整路径文件名*/
/*旧文件另存为新文件*/
Application.DisplayAlerts = False/*文件打开过程中会有一个提示格式不匹配提示弹窗，将其默认关闭*/
obook.SaveAs Filename:=new_name, FileFormat:=xlExcel8 _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False/*设置参数*/
Set nbook = GetObject(new_name)
Windows(new_file_name).Visible = True/*新文件保存后视图被关闭，设置打开*/
nbook.Save/*保存*/
nbook.Close/*关闭*/
Next i
Next j
End Sub
|