Tuesday 11 September 2012

Converting .xlsx to .xls


Option Explicit
Sub Convert_to972003()
    Dim orgwb As Workbook
    Dim mypath As String, strfilename As String
    Dim nname As String

    '--> Error Handling
    On Error GoTo WhatHappened
   
    '--> Disable Alerts
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    '--> Specify location of workbooks
    mypath = "C:\xxx"
    strfilename = Dir(mypath & "\*.xlsx", vbNormal)

    '--> Check the specified folder contains files
    If Len(strfilename) = 0 Then Exit Sub
   
    '--> Start Loop, end when last file reached
    Do Until strfilename = ""
   
    '--> Open a workbook
        Set orgwb = Application.Workbooks.Open _
        (mypath & "\" & strfilename)

        '--> Create new Filename, Save in new File Format and Close
        nname = Replace(strfilename, ".xlsx", ".xls")
        orgwb.SaveAs mypath & "\" & nname, FileFormat:=xlExcel8
        orgwb.Close
        strfilename = Dir()
    Loop
   
    '--> Enable Alerts
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
 
Exit Sub

WhatHappened: MsgBox Err.Description

End Sub

Does the job but the execution is very slow. 10 seconds for 20 small files locally, must be a quicker way than  Looping Open/SaveAs/Close, just don't know it yet..