Category Archives: VB

vb6: Export ADO recordset to excel

This simple piece of code to export one recordset to excel

 
' ------------------------------------------------------------------------------------
' \\ -- function to export the ADO recordset to  Excel
' ------------------------------------------------------------------------------------
Private Function Exportar_ADO_Excel(rec As ADODB.Recordset) As Boolean
      
    On Error GoTo errSub
      
    'Dim cn          As New ADODB.Connection
    'Dim rec         As New ADODB.Recordset
    Dim Excel       As Object
    Dim Libro       As Object
    Dim Hoja        As Object
    Dim arrData     As Variant
    Dim iRec        As Long
    Dim iCol        As Integer
    Dim iRow        As Integer
      
    Me.Enabled = False
      
     
    ' -- Create Excel objects
    Set Excel = CreateObject("Excel.Application")
    Set Libro = Excel.Workbooks.Add
      
    ' -- open sheet
    Set Hoja = Libro.Worksheets(1)
      
    Excel.Visible = True: Excel.UserControl = True
    ' -- send headers
    iCol = rec.Fields.Count
    For iCol = 1 To rec.Fields.Count
        Hoja.Cells(1, iCol).Value = rec.Fields(iCol - 1).Name
    Next
      
    If Val(Mid(Excel.Version, 1, InStr(1, Excel.Version, ".") - 1)) > 8 Then
        Hoja.Cells(2, 1).CopyFromRecordset rec
    Else
  
        arrData = rec.GetRows
  
        iRec = UBound(arrData, 2) + 1
          
        For iCol = 0 To rec.Fields.Count - 1
            For iRow = 0 To iRec - 1
  
                If IsDate(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = Format(arrData(iCol, iRow))
  
                ElseIf IsArray(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = "Array Field"
                End If
            Next iRow
        Next iCol
              
        ' -- send all records to  Excel
        Hoja.Cells(2, 1).Resize(iRec, rec.Fields.Count).Value = GetData(arrData)
    End If
  
    Excel.Selection.CurrentRegion.Columns.AutoFit
    Excel.Selection.CurrentRegion.Rows.AutoFit
  
   
    ' -- delete references
    Set Hoja = Nothing
    Set Libro = Nothing
    ' not quit excel
    'Excel.Quit
    'Set Excel = Nothing
      
    Exportar_ADO_Excel = True
    'Me.Enabled = True
    Exit Function
errSub:
    MsgBox Err.Description, vbCritical, "Error"
    Exportar_ADO_Excel = False
    Me.Enabled = True
End Function

Facebooktwittergoogle_plusredditpinterestlinkedinmail

Read More ...

Export a Access Recordset to Excel

Sometimes, in Ms. Ascces, I was need to export the current form recordsource to Ms. Excel, with vba code.

the best esay way to to this is:

Private Sub cmdtoexcel_Click()
     TempSQL = Me.RecordSource
     If IsNull(DLookup("name", "msysobjects", "name='query1'")) Then
         CurrentDb.CreateQueryDef "Query1", TempSQL
     Else
         CurrentDb.QueryDefs("Query1").SQL = TempSQL
     End If
     Dim dlgOpen As FileDialog
     Set dlgOpen = Application.FileDialog(msoFileDialogSaveAs)
     With dlgOpen
             .InitialFileName = "f:\initial directory"
     End With
 
     If dlgOpen.Show = 0 Then
         Exit Sub
     Else
         ' Code if "action" button was clicked...
         DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLS, dlgOpen.SelectedItems(1), 0
     End If
end sub
Facebooktwittergoogle_plusredditpinterestlinkedinmail

Read More ...

Categories

Subscribe to my Newsletter

By continuing to use the site, you agree to the use of cookies. more information

The cookie settings on this website are set to "allow cookies" to give you the best browsing experience possible. If you continue to use this website without changing your cookie settings or you click "Accept" below then you are consenting to this.

Close