Friday, June 17, 2011

Create an Excel worksheet from Recordset using VBA(Visual Basic Access)


' Subroutine to create an excel work sheet having data from a RecordSet
Public Sub ExcelSheetGeneration(ByVal arg_RecordSet As ADODB.Recordset)


    ' Creating Excel workbook with three sheets
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)


    Dim iCols As Integer

    DoCmd.Hourglass True
   
    'Formatting of excel sheet
    'Set row 1 text, bold and center
    xlSheet.Range(xlSheet.Cells(1, 1), _
        xlSheet.Cells(1, arg_RecordSet .Fields.count)).NumberFormat = "@"
    xlSheet.Range(xlSheet.Cells(1, 1), _
        xlSheet.Cells(1, arg_RecordSet .Fields.count)).Font.Bold = True
    xlSheet.Range(xlSheet.Cells(1, 1), _
        xlSheet.Cells(1, arg_RecordSet .Fields.count)).HorizontalAlignment = xlCenter
   
    'Get column names for excel worksheet from recoedsheet
     For iCols = 0 To arg_RecordSet .Fields.count - 1
        'Look for Excel override column name.  If not, then look for regular Display Column name.
         xlSheet.Cells(1, iCols + 1).Value = arg_RecordSet .Fields(iCols).Name
     Next
   
    'Load spreadsheet
    xlSheet.Cells(2, 1).CopyFromRecordset arg_RecordSet
    On Error GoTo Error_Exit
   
    'Formatting of excel sheet
    xlSheet.Columns("A:BB").Columns.AutoFit
    xlSheet.Range(xlSheet.Cells(1, 1), _
        xlSheet.Cells(65536, arg_RecordSet .Fields.count)).VerticalAlignment = xlCenter
    xlSheet.Range(xlSheet.Cells(1, 1), _
        xlSheet.Cells(65536, arg_RecordSet .Fields.count)).WrapText = True



    xlBook.Sheets("Sheet1").Select
    xlBook.Sheets("Sheet1").Name = Left("Excel Work Sheet Name", 31)
   
    xlBook.Application.Visible = True
    xlApp.ActiveWindow.FreezePanes = True
        

Normal_Exit:
    DoCmd.Hourglass False
    Set xlSheet = Nothing
    Set arg_RecordSet = Nothing
    Exit Sub
   
Error_Exit:
    DoCmd.Hourglass False
    MsgBox Err.Number & "-" & Err.Description
    Resume Normal_Exit
   
End Sub

Getting selected fields in a Recordset from another Recordset using VBA(Visual Basic Access)


' It is a function having a parent recordset which will return another recordset having selected columns
Function InfoSheet(ByVal rst_parent As ADODB.Recordset) As ADODB.Recordset

    'Temporary recordset, which will have selected fields from parent recordset and will be returned from this function
    Dim rst_Temp As ADODB.Recordset
    Set rst_Temp = New ADODB.Recordset

    'Adding required number of Columns in temporary recordset : Datatypes must be same
    'If there is null values then it must be declared  adFldIsNullable
    With rst_Temp.Fields
        .Append "Field 1", adInteger, 4, adFldIsNullable
        .Append "Field 2", adVarChar, 50, adFldIsNullable
        .Append "Field 3", adVarChar, 25, adFldIsNullable
    End With
   
    'Add rows into recordset, having all data of those columns from parent recordset
    With rst_Temp
        .Open
        If arg_rst.RecordCount > 0 Then
            Do While Not (arg_rst.EOF)
                .AddNew
                    ![Field 1] = rst_parent .Fields.Item(0).Value
                    ![Field 2] = rst_parent .Fields.Item(1).Value
                    ![Field 3] = rst_parent .Fields.Item(6).Value
                .Update
                arg_rst.MoveNext
            Loop
        Else
            MsgBox "No Records Found"
        End If

        rst_Temp.Update
        arg_rst.MoveFirst
        'Dont close temporary recordset else data will not be available in this inside calling routine or function
    End With
   
    Set InfoSheet = rst_Temp   
End Function

My Projects

  • J2EE Online entertainment world(fully running)

My Blog List