Wednesday, February 22, 2012

Bring 2003 and earlier docs up to the newest format [Excel VBA]

I often work with data exports from Oracle SAP, Business Warehouse, and Discoverer Plus.  The front-ends for each of these save, when selecting the option to export to a spreadsheet, the data to ".xls".

When opening these ".xls" files in Excel 2007 or later, you're still restricted to the row/column limitations of older versions of Excel (read: < 2003) as Excel enables compatibility mode.  Compatibility mode also limits some of the functions available to newer versions of Excel (I often get mad when structured references from tables are not available...grr).  

What did I do to solve this?  Save to a newer Excel format (typically ".xlsx" since no macros were in the original data files), close the file (to exit compatibility mode), delete the old ".xls" file, and finally reopen my new ".xlsx" file.  Get's tedious when you're pulling a metric ton of data daily.

What do I do know?  I use the code below.  It takes your file, saves it with the same file name but with a ".xlsx" extension to the directory the files currently in, closes the old file, deletes the file, and then reopens the new file.  All in a split second.  

It's the little things.

P.S. Make sure you turn on the reference to the "Windows Script Host Object Model"

'---------------------------------------------------------------------------------------
' Procedure : Save_To_XSLX_File
' Author    : Business Bear
' Date      : 1/20/2012
' Purpose   : Saves file to an XLSX file.  Good for updating 2003 files to later formats.
'---------------------------------------------------------------------------------------
'
Sub Save_To_XSLX_File()
Dim sFilename As String
Dim ws As Workbook
Dim Pos As Long
Dim sDir As String
Dim FSO As FileSystemObject
Dim sOldFileName As String

Const ext As String = ".xlsx"

DisplayAlerts = False
EnableEvents = False
Set wb = ActiveWorkbook
'Save directory and file names for future use
sDir = wb.FullName
sFilename = wb.Name
'Trim dir name to remove file name
sDir = Left(sDir, Len(sDir) - Len(sFilename))
sOldFileName = sDir & sFilename
Pos = InStrRev(wb.Name, ".") - 1
'Remove old extension from name
sFilename = Left(sFilename, Pos)
sFilename = sFilename & ext
'Simple solution in case user tries to save over a newer file
'and decides not to complete the process
On Error GoTo Exit_Me
'Save new file
wb.SaveAs Filename:=sDir & sFilename, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Close old workbook
wb.Close
Set FSO = New FileSystemObject
'Warning - DELETES OLD FILE
FSO.DeleteFile FileSpec:=sOldFileName
'Opens workbook in new format
Workbooks.Open (sDir & sFilename)
Exit_Me:
DisplayAlerts = True
EnableEvents = True
End Sub

No comments:

Post a Comment