使用VBA批量轉換Excel格式，由.xls轉換成.xlsx

賈樹丙發表於2017-04-07
Excel

問題分析：

　　Excel2007以前的格式是.xls，之後的格式是.xlsx。開啟單獨的一個Excel文件，使用“另存為”功能，可以很輕鬆的轉換格式。但是面對幾百個Excel表這樣就太累了，搜尋很久，也沒發現一個工具可以直接批量進行格式轉換。

　　最終發現可以使用VBA來實現批量轉換Excel格式的功能。大家不要被嚇到，VBA我也不懂，程式碼是從別人那裡搞到的，現在也只是知道了怎麼使用，但這足夠解決問題了

VBA介紹：
　　1、VBA是一種程式語言，它依託於Office軟體，不能獨立的執行，通過VBA可以實現各種Office軟體操作的自動化。
　　2、Visual Basic for Applications(VBA)是Visual Basic的一種巨集語言，主要能用來擴充套件Windows的應用程式功能。使用Excel的VBA開發的Excel文件，在Excel中執行時需要開啟Excel的巨集功能，否則此文件的VBA自動化功能將被完全遮蔽，文件的功能無法實現。

執行條件：
　　1、Office2007及以上版本的Excel
　　2、Excel啟用巨集

工具下載：
　　可以自己新建Excel，編寫VBA程式碼，程式碼在後面。也可以使用我提供的已經寫好的兩個，以下是百度網盤中的連結：
　　　　《xls2xlsx.xlsm》
　　　　連結：http://pan.baidu.com/s/1mit3FGc 密碼：s57a
　　　　《Convert2xlsx.xlsm》
　　　　連結：http://pan.baidu.com/s/1sluFttb 密碼：pguv

　　分享的內容無法訪問了，百度網盤有點小坑啊，不過程式碼就是下邊貼出來的那些，手動貼上吧...

功能介紹：
　　先介紹這兩個工具功能，大家可以根據需要下載。
　　《xls2xlsx.xlsm》會在所在資料夾目錄中、包括子目錄中，遍歷所有.xls格式的檔案，執行“另存為”操作，然後在原檔案當前位置另存為一個同名的.xlsx格式的檔案。
　　比如：執行前xls2xlsx.xlsm所在的資料夾中有3個.xls格式的檔案，同時包含一個子資料夾，子資料夾中也有3個.xls格式的檔案

 　　　　　　　　

　　執行後，會生成如下檔案：

 　　　　　　　　

　　《Convert2xlsx.xlsm》會在所在資料夾目錄中（不包括子目錄），遍歷所有.xls格式的檔案，執行“另存為”操作，然後在當前路徑下生成一個資料夾xlsx，這個資料夾中放了所有新生成的檔案。
　　比如：執行前Convert2xlsx.xlsm所在的資料夾中有3個.xls格式的檔案

　　　　

　　執行後，會生成如下檔案：

　　　　　　　　

執行方法：
　　1、從上面下載任意一個工具，或者新建一個Excel；
　　2、啟用巨集操作
　　一般情況下，開啟Excel的時候，會彈出如下警告

　　　　

　　如果彈出了這個警告，直接啟用就可以了；如果沒有出現的話，請參考以下百度經驗啟用巨集http://jingyan.baidu.com/article/39810a23e39b9db637fda651.html
　　3、編寫執行VBA程式碼
　　這一步新手肯定是不會的，詳細地圖文介紹就參考百度經驗http://jingyan.baidu.com/article/09ea3ede265e8bc0aede39ba.html，我這裡只作簡單的說明：
　　　　(a)在工作表介面按下組合快捷鍵Alt+F11或者右鍵單擊任意一個工作表標籤，在彈出的右鍵快捷選單單擊“檢視程式碼”進入VBA編輯環境
　　　　(b)如果是下載的我的工具，可以跳過此步驟；如果是新建的Excel，此時在VBA編輯環境中的“程式碼視窗”複製貼上以下兩個程式碼中的一個：
　　　　《xls2xlsx.xlsm》

 1 '***********訪問當前資料夾下所有子資料夾及檔案,
 2 Dim iFile(1 To 100000) As String
 3 Dim count As Integer
 4 
 5 Sub xls2xlsx()
 6     iPath = ThisWorkbook.Path
 7     On Error Resume Next
 8     count = 0
 9     zdir iPath
10     For i = 1 To count
11         If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
12             MyFile = iFile(i)
13             FilePath = Replace(MyFile, ".xls", ".xlsx")
14             If Dir(FilePath, 16) = Empty Then
15                 Set WBookOther = Workbooks.Open(MyFile)
16                 Application.ScreenUpdating = False
17                 ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
18                 WBookOther.Close SaveChanges:=False      '解決不能close 檔案問題
19                 Application.ScreenUpdating = True
20             End If
21         End If
22     Next
23 End Sub
24 
25 Sub zdir(p)       '訪問當前資料夾下所有子資料夾及檔案
26   Set fs = CreateObject("scripting.filesystemobject")
27   For Each f In fs.GetFolder(p).Files
28     If f <> ThisWorkbook.FullName Then count = count + 1: iFile(count) = f
29   Next
30   For Each m In fs.GetFolder(p).SubFolders
31       zdir m
32   Next
33 End Sub

 

　　　　《Convert2xlsx.xlsm》

 1 Sub xls2xlsx()
 2 Dim FilePath, MyFile, iPath, Name, OutPath As String
 3 iPath = ThisWorkbook.Path
 4 OutPath = Dir(iPath & "\xlsx", vbDirectory)
 5 If OutPath = "" Then
 6     MkDir (iPath & "\xlsx")
 7 End If
 8 MyFile = Dir(iPath & "\*.xls")
 9 
10 If MyFile <> "" Then
11 Do
12     On Error Resume Next
13     If MyFile = ThisWorkbook.Name Then MyFile = Dir
14     Workbooks.Open (iPath & "\" & MyFile)
15     MyFile = Replace(MyFile, ".xls", ".xlsx")
16     Name = "\" & MyFile
17     FilePath = iPath & "\xlsx" & Name
18     Application.ScreenUpdating = False
19     ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
20     Workbooks(MyFile).Close True
21     Application.ScreenUpdating = True
22     MyFile = Dir
23 Loop While MyFile <> ""
24 End If
25 End Sub

 

　　　　(c)按下F5快捷鍵執行這段程式碼或者在選單中單擊“執行子過程/使用者窗體”命令

　　PS：需要說明的是，在執行過程中，不要去做其他的事情，不然可能會中斷程式的執行

 

 

　　後來有同學提了些問題，最後執行程式碼的時候，並沒有達到效果。先來看下正常的效果，會先彈出一個對話方塊，然後執行

 

　　出問題的原因是：在資料夾中的 .xls的字尾是大寫的。這導致了程式碼不能執行，不過這種情況稍微修改下就可以了

 

　　我還試了一下，如果同目錄下 .xls 和 .xlsx同時存在，也執行不了……

 

　　原創文章，歡迎轉載，轉載請註明出處！

 

相關文章