iT邦幫忙

0

批次轉換Excel格式, 由xls轉為xlsx

  • 分享至 

  • xImage
  •  

**批次轉換Excel存檔格式, 由xls轉為xlsx

xls格式是Excel2003及以前的Excel版本, 該格式數據只支援到256列和65536行, 且xls格式與xlsx格式檔案大小也有差異, 檔案體積的差異最小有2倍之多, 最大有10倍之多

Sub ConvertToXlsx()
    Dim strPath As String
    Dim strFile As String
    Dim xWbk As Workbook
    Dim xSFD, xRFD As FileDialog
    Dim xSPath As String
    Dim xRPath As String
    'xls 存放的資料夾
    Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
    With xSFD
        .Title = "Please select the folder contains the xls files:"
        .InitialFileName = "C:\"
    End With
    If xSFD.Show <> -1 Then Exit Sub
    xSPath = xSFD.SelectedItems.Item(1)
    '轉為 xlsx 後要存放的資料夾
    Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
    With xRFD
        .Title = "Please select a folder for outputting the new files:"
        .InitialFileName = "C:\"
    End With
    If xRFD.Show <> -1 Then Exit Sub
    xRPath = xRFD.SelectedItems.Item(1) & "\"
    
    strPath = xSPath & "\"
    strFile = Dir(strPath & "*.xls")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '開啟xls 另存為xlsx
    Do While strFile <> ""
        If Right(strFile, 3) = "xls" Then
            Set xWbk = Workbooks.Open(Filename:=strPath & strFile)
            xWbk.SaveAs Filename:=xRPath & strFile & "x", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            xWbk.Close SaveChanges:=False
        End If
        strFile = Dir
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

尚未有邦友留言

立即登入留言