VBA循环Excel文件并另存为.xlsx

最近在学习VBA，因为工作中有很多重复的操作太过于消耗时间，过年假期基本没太出门，研究了一个星期的VBA算是入了门，能做点简单的东西，这两周一直在研究VBA怎么操作Outlook，也有了眉目，进而使用VBA实现当前工作的自动化。

今天分享一个VBA循环Excel文件并另存为.xlsx文件的代码。工作场景主要是公司后台下载的表格无法直接导入本地数据库并且无法被Power Query加载，由于源文件有十几个，手工操作工作量又大，之前在网上找了一个代码，这次我自己重新写了一个。

使用方法：

• 在需要循环的文件中，新建一个Excel文件，然后粘贴代码运行。
• 代码运行完会自动删除原来的.xls文件

Sub 遍历文件并另存为()
  Dim filename As String, mypath As String, k As Integer, fullna As String
  mypath = ThisWorkbook.Path '返回代码所在文件的路径
  filename = Dir(mypath & "\*.xls") '实际返回的只是文件名
  Do
    fullna = mypath & "\" & filename '加上路径用\连接文件名才是完整的文件路径，这句得写在循环里面根据循环变化，然后使用Kill删除文件
    If filename Like "*.xls" And filename <> ThisWorkbook.FullName Then '条件是文件类型是.xls，并且循环的路径不等于代码所在的文件
        Workbooks.Open (fullna) '打开循环文件，打开的依然是.xls格式的文件
        cc = Replace(fullna, ".xls", ".xlsx") '将路径中文件的.xls替换为.xlsx作为另存为的文件名称及路径
        ActiveWorkbook.SaveAs filename:=cc, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False '通过录制宏获得
        ActiveWorkbook.Close False '关闭文件，不保存Colse后面 True是保存
        Kill fullna '删除原来的.xls文件
    End If
    filename = Dir '再次载入路径用以循环使用
  Loop Until filename = ""  '循环停止条件
  MsgBox "另存为并删除完毕"
 End Sub

代码中已做了注释，不懂的可以留言。