[已解决]批量将xls工作簿批量转成xlsx工作簿

天棋

Sub 更改格式()
  Dim objShell As Object
  Set objShell = CreateObject("Wscript.Shell")
  Dim msg As String
  Dim f, Mywb As String, str$
  Dim Sht As Worksheet
  Dim i As Long
  Dim count As Integer
   Application.ScreenUpdating = False
   Mywb = ThisWorkbook.Name
    f = Dir(ThisWorkbook.Path & "\*.xls")  'F是工作簿名称
    Do While f > ""
        If f <> Mywb Then
             str = str & vbCrLf & f
             On Error Resume Next
             Workbooks.Open Filename:=ThisWorkbook.Path & "\" & f  '打开该工作簿
             Workbooks(f).SaveAs Filename:=ThisWorkbook.Path & "\" & f & ".xlsx"   '将工作簿另存为xlsx格式的工作簿，该句代码有问题？ 这里求帮助
             Workbooks(f).Save  '原工作簿保存关闭
             Workbooks(f).Close
             count = count + 1 '计数 执行几次
        End If
        f = Dir  '下一个工作簿名字
    Loop
   Application.ScreenUpdating = True
   objShell.Popup "本次共执行了" & count & "个工作簿，分别为" & str & Chr(10) & "请仔细核对！！！", 0, "温馨提示", vbInformation
   Set objShell = Nothing
End Sub
框架已经写完，关键代码不对？求帮助

最佳答案

月排行榜 / 总排行榜

爱疯

2015-2-12 10:35

这句改成

Workbooks(f).SaveAs Filename:=ThisWorkbook.Path & "\" & f, FileFormat:=51

跳转到最佳答案楼层

爱疯

这句改成

Workbooks(f).SaveAs Filename:=ThisWorkbook.Path & "\" & f, FileFormat:=51

天棋

好像没对呢

QLZ0602

天棋 发表于 2015-2-12 11:02
好像没对呢

      Workbooks(f).SaveAs Filename:=ThisWorkbook.Path & "\" & f & ".xlsx"   '将工作簿另存为xlsx格式的工作簿，该句代码有问题？
  f  应该包含 .xls    所以要只取文件名 不要扩展名
   增加 f2=split(f,".")
            Workbooks(f).SaveAs Filename:=ThisWorkbook.Path & "\" & f2(0) & ".xlsx"

天棋

QLZ0602 发表于 2015-2-12 12:01
Workbooks(f).SaveAs Filename:=ThisWorkbook.Path & "\" & f & ".xlsx"   '将工作簿另存为xlsx格式 ...

是的 f是包含了后缀名字 。您这种方法可以创建，但是系统不认呢打不开。

天棋

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Left(f, Len(f) - 4), FileFormat:=51  综合二位老师这种可以实现 {:171:}感谢

exc姜