Excel格式轉化工具

背景

最近作項目，業務有幾百個Excel文件須要上傳到系統，因爲是薪酬數據內容保密，原始文件不能提供，給了Excel 2007格式的測試數據。

用java代碼解析Excel 2007格式，開發完成以後進入UAT，客戶測試時說原始文件格式是Excel 2003版本的，給的文件是轉化以後的，無奈之下

從新開發Excel 2003版本解析，代碼寫完交付UAT測試，發現異常，排查緣由Excel 2003的原始數據居然是html格式的文本文件，

實在不想再寫java代碼去解析html格式的Excel 2003了，所以用VB作了這個小工具，實現文件格式批量轉化。

工具和源代碼下載地址

 https://pan.baidu.com/s/16346pcwKXX3oRXA0GtcWlQ

頁面

 

 

 

 代碼

Rem 加載目標文件格式
Private Sub Form_Load() TypeList.List(0) = "Excel 2003" TypeList.List(1) = "Excel 2007"
End Sub


Rem 格式轉換過程
Private Sub Convert_Click() Rem 定義變量：源文件夾路徑、目標文件夾路徑、目標文件格式、目標文件名後綴
Dim SourceDir$, TargetDir$, ExcelTypeIn$, suffix$ Rem 判斷源文件夾路徑是否存在
SourceDir = Text1.Text If Dir(SourceDir, vbDirectory) = "." Then
MsgBox "源文件夾路徑不能爲空！"
Exit Sub
ElseIf Dir(SourceDir, vbDirectory) = "" Then
MsgBox "源文件夾路徑" & SourceDir & "不存在！"
Exit Sub
End If SourceDir = SourceDir & "\"

Rem 判斷目標文件夾路徑是否存在
TargetDir = Text2.Text If Dir(TargetDir, vbDirectory) = "." Then
MsgBox "目標文件夾路徑不能爲空！"
Exit Sub
ElseIf Dir(TargetDir, vbDirectory) = "" Then
MsgBox "目標文件夾路徑" & TargetDir & "不存在！"
Exit Sub
End If TargetDir = TargetDir & "\"

Rem 判斷源文件夾路徑和目標文件夾路徑是否相等
If SourceDir = TargetDir Then
MsgBox "源文件夾路徑和目標文件夾路徑不能相等！"
Exit Sub
End If

Rem 判斷目標文件的格式
ExcelTypeIn = Val(TypeList.ListIndex) If ExcelTypeIn = "0" Then suffix = ".xls"
ElseIf ExcelTypeIn = "1" Then suffix = ".xlsx"
Else
MsgBox "請選擇目標文件格式！"
Exit Sub
End If

Rem 當前系統安裝什麼Excel就得到相應的excel.application
Dim ExApp As Object
Set ExApp = CreateObject("excel.application") ExApp.Application.ScreenUpdating = False

Dim sourceFile$, targetFile$ sourceFile = Dir(SourceDir & "*.xls") Do While sourceFile <> "" targetFile = Left(sourceFile, InStr(sourceFile, ".") - 1) & suffix  '目標文件名稱

Rem --------------------------具體轉化過程開始----------------------------
ExApp.Workbooks.Open (SourceDir & sourceFile) ExApp.Application.DisplayAlerts = False
If ExcelTypeIn = "0" Then ExApp.ActiveWorkbook.SaveAs TargetDir & targetFile, xlExcel8     '轉換爲2003格式
ElseIf ExcelTypeIn = "1" Then ExApp.ActiveWorkbook.SaveAs TargetDir & targetFile, 51         '轉換爲2007格式
End If ExApp.Application.DisplayAlerts = True ExApp.ActiveWorkbook.Close True
Rem --------------------------具體轉化過程結束----------------------------
 sourceFile = Dir   '得到文件夾中的下一個文件
Loop ExApp.Application.ScreenUpdating = False
MsgBox "文件夾內的全部Excel文件格式轉換完畢！"
End Sub


Rem 結束按鈕的事件程序
Private Sub CloseCmd_Click() End
End Sub

 

方式二：在Excel文件中執行，這種形式是多線程執行，速度比較快

1.新建一個Excel文件

2.Alt + F11

3.Alt + im

4.鼠標點擊到首行

5.點擊運行-->運行子過程或用戶窗體

Private Sub Workbook_Open() Dim SourceDir$, TargetDir$, ExcelTypeIn$, suffix$ Rem ----------------------修改以下三個數據開始------------------------
SourceDir = ""                           '源文件夾路徑
TargetDir = ""                            '目標文件夾路徑
ExcelTypeIn = "0"                       '0-Excel2003 1-Excel2007 Rem ----------------------修改以下三個數據結束------------------------
SourceDir = SourceDir  & "\" TargetDir = TargetDir  &  "\"
If ExcelTypeIn = "0" Then suffix = ".xls"
ElseIf ExcelTypeIn = "1" Then suffix = ".xlsx"
End If Application.ScreenUpdating = False
Dim SourceFile$,targetFile$ SourceFile = Dir(SourceDir & "*.xls") Do While SourceFile <> "" targetFile = Left(sourceFile, InStr(sourceFile, ".") - 1) & suffix  '目標文件名稱
    If SourceFile <> ThisWorkbook.Name Then Workbooks.Open SourceDir & SourceFile Application.DisplayAlerts = False ActiveWorkbook.SaveAs TargetDir & targetFile, xlExcel8 Application.DisplayAlerts = True ActiveWorkbook.Close True
    End If SourceFile = Dir
Loop Application.ScreenUpdating = False
MsgBox "本文件夾內的全部Excel文件打開另存完畢！"
End Sub