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

問題分析：

　　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》

'***********訪問當前文件夾下所有子文件夾及文件,
Dim iFile(1 To 100000) As String
Dim count As Integer

Sub xls2xlsx()
    iPath = ThisWorkbook.Path
    On Error Resume Next
    count = 0
    zdir iPath
    For i = 1 To count
        If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
            MyFile = iFile(i)
            FilePath = Replace(MyFile, ".xls", ".xlsx")
            If Dir(FilePath, 16) = Empty Then
                Set WBookOther = Workbooks.Open(MyFile)
                Application.ScreenUpdating = False
                ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                WBookOther.Close SaveChanges:=False      '解決不能close 文件問題
                Application.ScreenUpdating = True
            End If
        End If
    Next
End Sub

Sub zdir(p)       '訪問當前文件夾下所有子文件夾及文件
  Set fs = CreateObject("scripting.filesystemobject")
  For Each f In fs.GetFolder(p).Files
    If f <> ThisWorkbook.FullName Then count = count + 1: iFile(count) = f
  Next
  For Each m In fs.GetFolder(p).SubFolders
      zdir m
  Next
End Sub

 

　　　　《Convert2xlsx.xlsm》

Sub xls2xlsx()
Dim FilePath, MyFile, iPath, Name, OutPath As String
iPath = ThisWorkbook.Path
OutPath = Dir(iPath & "\xlsx", vbDirectory)
If OutPath = "" Then
    MkDir (iPath & "\xlsx")
End If
MyFile = Dir(iPath & "\*.xls")

If MyFile <> "" Then
Do
    On Error Resume Next
    If MyFile = ThisWorkbook.Name Then MyFile = Dir
    Workbooks.Open (iPath & "\" & MyFile)
    MyFile = Replace(MyFile, ".xls", ".xlsx")
    Name = "\" & MyFile
    FilePath = iPath & "\xlsx" & Name
    Application.ScreenUpdating = False
    ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Workbooks(MyFile).Close True
    Application.ScreenUpdating = True
    MyFile = Dir
Loop While MyFile <> ""
End If
End Sub

 

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

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

 

---

 

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

 

　　出問題的原因是：在文件夾中的 .xls的后綴是大寫的。這導致了代碼不能執行，不過這種情況稍微修改下就可以了

 

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

 

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