UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> ArrayToExcel    
Function Information
Applicable Versions

- Any

Dependancies

- Visual Basic for Applications
- Excel Object Model (Late Binding)

CODE

'---------------------------------------------------------------------------------------------------------------------------------------
' 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

Creative Commons License
ArrayToExcel by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 3,534 times.  This page was last modified 12:41, 6 September 2012 by Jack Leach. Contributions by dipetete  Disclaimers