excel批量另存为1

发布网友发布时间：2024-01-23 21:31

共2个回答

热心网友时间：2024-10-11 20:18

Private Declare Function PathFileExists Lib "shlwapi" Alias "PathFileExistsA" (ByVal pszPath As String) As Long   '判断文件夹是否存在
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll " (ByVal DirPath As String) As Long                         '创建多层目录
Sub BatSaveAs97_2003()
   Dim Path As String, Pos As Long, FName As String, NewFName As String
   Dim WrkBook As Object
    Path = ActiveWorkbook.Path
    If Val(Application.Version) < 12 Then
      MsgBox "本机未安装Office 2007及以上版本的Excel应用程序，功能禁用！", vbCritical + vbOKOnly, "消息"
      Exit Sub
    End If
    If PathFileExists(Path & "\转换后的97-2003文档集") = 0 Then MakeSureDirectoryPathExists Path & "\转换后的97-2003文档集\"
    FName = Dir(Path & "\*.xlsx")
   If FName <> "" Then
     Application.DisplayAlerts = False
     Do
       NewFName = Path & "\转换后的97-2003文档集\" & Left(FName, Len(FName) - 5) & ".xls"
       FName = Path & "\" & FName
       On Error Resume Next
       Set WrkBook = Application.Workbooks.Open(FName)
       If Err.Number = 0 Then
          On Error Resume Next
           WrkBook.SaveAs Filename:=NewFName, FileFormat:=56
           WrkBook.Close
           Set WrkBook = Nothing
       End If
        FName = Dir()
        DoEvents
     Loop While FName <> ""
       Application.DisplayAlerts = True
      MsgBox "xlsx转xls处理完毕！" & vbCrLf & "更多丰富、实用、强大的文件批量处理功能，请参见《文件_批量处理_百宝箱_V10.0》", vbInformation + vbOKOnly, "消息"
     Shell "explorer.exe " & Path & "\转换后的97-2003文档集", vbNormalFocus
    End If
End Sub

将该压缩包解压之后，在解压后的文件夹中，新建一个Office 2007及以上版本的Excel文档，然后按Alt+F11打开VBA代码编辑器，然后将上述代码原因粘贴进去，然后将光标置于代码内，然后按F5运行，大概3到5分钟就处理完了。

热心网友时间：2024-10-11 20:18

需要写VBA程序处理一下

热心网友时间：2024-10-11 20:18

热心网友时间：2024-10-11 20:19

需要写VBA程序处理一下