ArrayToExcel

Exports a 2D array to Excel.

'---------------------------------------------------------------------------------------------------------------------------------------
' ArrayToExcel
' http://www.utteraccess.com/wiki/index.php/ArrayToExcel
' Code courtesy of UtterAccess Wiki
' Original submission by Diego F.Pereira-Perdomo
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev date brief descripton
' 1.0 2012-07-11 Exports a 2D array to Excel.
' w: The name of the 2D array.
' strPath: The path in which the xlsx File is going to be saved.
' strFile: The name of the xlsx File
' strSheetName: Optional. Sheet Name
'---------------------------------------------------------------------------------------------------------------------------------------
Private Function ArrayToExcel(w() As Variant, _
strPath As String, _
strFile As String, _
Optional strSheetName As String = "")

On Error GoTo ErrorHandler

Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object

Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Sheet1")

If Nz(strSheetName, "") <> "" Then
xlWs.Name = strSheetName
End If

With xlWb
xlWs.cells(1, 1).Resize(UBound(w, 1) + 1, UBound(w, 2) + 1).Value = w
End With

DoEvents
xlWb.SaveAs (strPath & strFile)

ExitFunction:

If Not xlApp Is Nothing Then
xlApp.Quit
End If

Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

Exit Function

ErrorHandler:
Select Case Err.Number
Case 0
Case Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitFunction
End Select
End Function