xls与xlsx互转代码

zgzxp

不能发附件，自己建窗体
代码如下
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} myCover
   Caption         =   "EXCLE批量转换格式"
   ClientHeight    =   4200
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4785
   OleObjectBlob   =   "myCover.frx":0000
   StartUpPosition =   1  '所有者中心
End
Attribute VB_Name = "myCover"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
Dim myFiles
Dim myDirS, myDirO As String
Dim i As Long

If Application.Version = "11.0" Then
MsgBox ("老大，Excel2003不能打开高版本文件，请在07以上版本进行转换！")
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox ("老大，你没有指定路径，让我转空气啊？")
Exit Sub
ElseIf Dir(TextBox1.Value, vbDirectory) = vbNullString Then
MsgBox ("老大，你确定源文件路径真的存在？")
Exit Sub
End If

If TextBox2.Value = "" Then TextBox2.Value = TextBox1.Value
'处理路径
If Right(TextBox1.Value, 1) = "\" Then TextBox1.Value = Left(TextBox1.Value, Len(TextBox1.Value) - 1)
If Right(TextBox2.Value, 1) = "\" Then TextBox2.Value = Left(TextBox2.Value, Len(TextBox2.Value) - 1)


myDirS = TextBox1.Value
myDirO = TextBox2.Value
'目标路径不存在时先建立
If Dir(myDirO, vbDirectory) = "" Then MkDir myDirO

On Error Resume Next
Application.ScreenUpdating = True
Application.DisplayAlerts = False
If OptionButton1.Value = True Then
'07-13格式转03格式
myFiles = Dir(myDirS & "\*.xlsx")
Do While myFiles <> ""
Workbooks.Open Filename:=myDirS & "\" & myFiles
ActiveWorkbook.SaveAs Filename:= _
myDirO & "\" & Left(myFiles, Len(myFiles) - 1), FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
'删除源文件
If CheckBox1.Value = False Then Kill myDirS & "\" & myFiles
i = i + 1
myFiles = Dir
DoEvents
Loop
MsgBox "全部转换完毕，共转换文件 " & i & "个"
'03格式转07-13格式
Else
myFiles = Dir(myDirS & "\*.xls")
Do While myFiles <> ""
If Right(myFiles, 1) = "x" Then GoTo NF
Workbooks.Open Filename:=myDirS & "\" & myFiles
ActiveWorkbook.SaveAs Filename:= _
myDirO & "\" & myFiles & "x", FileFormat:=xlOpenXMLWorkbook, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
i = i + 1
'删除源文件
If CheckBox1.Value = False Then Kill myDirS & "\" & myFiles
NF:
myFiles = Dir
DoEvents
Loop
MsgBox "全部转换完毕，共转换文件 " & i & "个"
End If

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

' 窗体初始化
Private Sub UserForm_Initialize()
TextBox1.Value = ActiveWorkbook.Path
    TextBox1.SetFocus
End Sub

YZC51

不错！谢谢楼主分享！

zgzxp

回复居然可以发附件了，添上附件

sunny_8848

谢谢楼主分享！

LIUZHU

个人觉得不适用

湛蓝阴影

有点意思，谢谢分享

坠入迷途

希望支持子文件夹文件？

chengshanming

路过，不错！顶一个！

chengshanming

zgzxp 发表于 2015-3-13 21:57
回复居然可以发附件了，添上附件

楼主好！经测试，好像03的转成07-03的不能批量转换格式！

zgzxp

chengshanming 发表于 2017-1-10 11:09
楼主好！经测试，好像03的转成07-03的不能批量转换格式！

啊，我这里测试是可以的啊