Question writing into excel

[developer123]

Hi all!! I am a beginner so might be a stupid question for you all...


I am retrieving data from MS Access on particular criteria(e.g. City='Delhi') now I want the data to be written in excel sheet in particular tabular format so that all the info of a person can be written on one side like the one below:

Anurag Manish

A-206, New Delhi J-20, New Delhi


I don't know how to do the same. Googled it but in vain, have understood nothing. so kindly help.

Thanks in Advance

 

[Mikeaj72]

Try this. rngSOD is where you want your first row of data. sSQL is your query that you will pass to Call RetrieveRecordset(sSQL, rngSOD)

Private Sub DataFromAccessToExcel()
        Dim rngSOD As Excel.Range

        xlApp = CreateObject("Excel.Application")
        xlWB = xlApp.Workbooks.Add
        xlWs = xlWB.Worksheets("Sheet1")
        ' Display Excel and give user control of Excel's lifetime
        With xlApp
            .Visible = True
            .UserControl = True
            rngSOD = .Range("A5")
            sSQL = "SELECT STATEMENT"
            'Retrieve the records
            Call RetrieveRecordset(sSQL, rngSOD)
            .Columns.AutoFit()
        End With
        xlWs.Select()
        xlApp = Nothing
    End Sub

Here you need to change glob_DBPath to the path of your databasae.

   Function RetrieveRecordset(ByVal strSQL As String, ByVal clTrgt As Excel.Range)
        'Constant for Database connection string
        RetrieveRecordset = ""
        glob_DBPath = "C:\Path\dbName.mdb;Persist Security Info=False"
        glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _      DBPath & ";"

        Dim cn As New ADODB.Connection
        Dim rs As New ADODB.Recordset

        'Open connection to the database
        With cn
            .Open(glob_sConnect)

            'Open recordset based on Orders table
            With rs
                .Open(strSQL, cn)
                   fldCount = rs.Fields.Count
                   For iCol = 1 To fldCount
                       xlApp.Cells(4, iCol).Value = rs.Fields(iCol - 1).Name
                   Next
                'Copy the recordset from the database
                On Error Resume Next
                clTrgt.CopyFromRecordset(rs)
                .Close()
            End With
            rs = Nothing			
            .Close()
        End With 
        cn = Nothing

    End Function

 

[Tom]

Similar question open here:
http://www.vbdotnetforums.com/xml/42377-how-export-datatable-excel-windows-app-using-xml.html

If that doesnt answer your question let me know

 

[ss7thirty]

It is possible you would want pseudo code instead to better understand

Application Object - Open excel application
Workbook Object - Create a new workbook
Worksheet Object - Do what you have to with this worksheets exist in a book
Connection(Connection String) - Connect to database with connection string
Open Connection
Command(Command Text, Connection String) - Create Command
Fill data reader with Command results - Datareader = command.execute

Loop Datareader.Read
Go through each record
Worksheet - via a loop or have a variable that increments each iteration of this loop to move to a new row in the worksheet assign value via Worksheet.Cells(x,y).Value is how I do it.

close all connections
save excel book
close excel book
quit xl app

 

[cjard]

Other options you have:

Write the data to a CSV file, which is often opened/openable by excel
Have a search for threads here that discuss how to write a datatable to an xml file that is openable by excel directly (I made one such simple library, called ExcelableData referred to in a few of my posts - it's a subclass of datatable, that has a WriteExcelXml() sub, that creates the file using the contents of the datatable)

 

[kanaida]

I find the BEST way to do this and not have to go crazy doing it, is do it in HTML and save it with a .xls extension. Then you can use it as the body in outlook emails, open it in browsers, and open it in excel all at once. You also do NOT need ms office installed.

I actually created a DLL full of extensions to various objects. This one will help you A LOT. I'm sure it's got a few bugs in it with special characters. but I've had it work for me 100% of the time for my projects, so when I see a bug I take care of it. For me, less code = less bugs.

And let me tell you, this approach for me is tried and tested. I only do things once now. and just add references to my extensions module. I make one module per object type that I am extending.

Try importing this module in any form then call
YourDataGridView.QuickSaveXML()

easy as pie.

Imports System.Runtime.CompilerServices
Imports System.Windows.Forms

    <Extension()> _
    Public Sub ColorCells(ByVal Expression As DataGridView, ByVal ColorSettings As List(Of CellColorSetting))

        Dim L As New List(Of DataGridViewRow)
        For Each R In Expression.Rows
            L.Add(R)
        Next

        For Each ColorSetting In ColorSettings
            For Each PropertyName In ColorSetting.ColumnNames.Split(",")
                If Not Expression.Columns.Contains(PropertyName) Then
                    Throw New Exception("Error Applying Color Style: The Column named '" & PropertyName & "' does not exist in " & Expression.Name)
                End If
            Next
            Dim Matches = L.FindAll(ColorSetting.ConditionToMatch)
            For Each Match In Matches
                Match.ApplyStyleToCell(ColorSetting.ColumnNames, ColorSetting.Style)

            Next

        Next


    End Sub

    <Extension()> _
Public Sub ColorRows(ByVal Expression As DataGridView, ByVal ColorSettings As List(Of CellColorSetting))

        Dim L As New List(Of DataGridViewRow)
        For Each R In Expression.Rows
            L.Add(R)
        Next

        For Each ColorSetting In ColorSettings

            Dim Matches = L.FindAll(ColorSetting.ConditionToMatch)
            For Each Match In Matches
                Match.ApplyStyleToRow(ColorSetting.Style)
            Next

        Next
    End Sub

    <Extension()> _
    Public Function ToCSV(ByVal Expression As DataGridView, Optional ByVal SelectedRowsOnly As Boolean = True, Optional ByVal Separator As String = ",") As String
        Dim SB As New Text.StringBuilder

        For Each column As DataGridViewColumn In Expression.Columns
            'SB.Append("""")

            SB.Append(Replace(column.HeaderText, vbCrLf, ""))
            'SB.Append("""")
            If Not column.Index = Expression.Columns.Count - 1 Then
                SB.Append(Separator)
            End If
        Next
        SB.AppendLine()

        For Each Row As DataGridViewRow In IIf(SelectedRowsOnly, Expression.SelectedRows, Expression.Rows)
            For Each Col As DataGridViewColumn In Expression.Columns
                'SB.Append("""")
                If Row.Cells(Col.Index).Value.GetType Is GetType(Date) Then
                    SB.Append(Row.Cells(Col.Index).Value.toshortdatestring)
                Else
                    SB.Append(Row.Cells(Col.Index).Value)
                End If

                'SB.Append("""")
                If Not Col.Index = Expression.Columns.Count - 1 Then
                    SB.Append(Separator)
                End If
            Next
            SB.AppendLine()
        Next

        Return SB.ToString
    End Function

    <Extension()> _
    Public Function ToHTML(ByVal Expression As DataGridView, Optional ByVal SelectedRowsOnly As Boolean = True, Optional ByVal IncludeHTMLandBodyTags As Boolean = True) As String
        Dim SB As New System.Text.StringBuilder
        If IncludeHTMLandBodyTags Then
            SB.AppendLine("<HTML>")
            SB.AppendLine("<BODY>")
        End If

        'Write Table
        SB.AppendLine("<TABLE border=1 bgcolor=#FFFFFF>")
        SB.AppendLine("<TR bgcolor=#D5D5D8>")
        For Each Column As DataGridViewColumn In Expression.Columns
            SB.Append("<TD>")
            SB.Append("<SPAN style=""font-family: arial, helvetica, sans-serif; font-size: 12px"">")
            SB.Append("<STRONG>")
            SB.Append(Trim(Column.HeaderText))
            SB.Append("</STRONG>")
            SB.Append("</SPAN>")
            SB.Append("</TD>")
        Next
        SB.AppendLine("</TR>")

        For Each Row As DataGridViewRow In IIf(SelectedRowsOnly, Expression.SelectedRows, Expression.Rows)
            SB.AppendLine("<TR>")
            For Each Column As DataGridViewColumn In Expression.Columns
                SB.Append("<TD bgcolor=")
                SB.Append(IIf(Row.Index Mod 2, "#F2EAB5", "#E3EEFB"))
                SB.Append(">")
                Dim Value = Trim(Row.Cells(Column.Index).FormattedValue.ToString)
                Select Case Row.Cells(Column.Index).Value.GetType.ToString

                    Case GetType(Date).ToString, GetType(Decimal).ToString 'Align Numbers and dates to the right
                        SB.Append("<p style=""text-align: right"">")
                        SB.Append("<SPAN style=""font-family: courier new, helvetica, sans-serif; font-size: 12px"">")
                        SB.Append(Value)
                        SB.Append("</SPAN>")
                        SB.Append("</p>")

                    Case GetType(Boolean).ToString
                        SB.Append("<p>")
                        SB.Append("<input checked=""")
                        SB.Append(IIf(Value, "checked", "unchecked"))
                        SB.Append(""" name=""CheckBox")
                        SB.Append(Column.Index)
                        SB.Append(" type=""checkbox"" value=""")
                        SB.Append(Value.ToString)
                        SB.Append("/>")
                        SB.Append("</p>")

                    Case Else
                        SB.Append("<SPAN style=""font-family: courier new, helvetica, sans-serif; font-size: 12px"">")
                        SB.Append(Value)
                        SB.Append("</SPAN>")
                End Select



                SB.AppendLine("</TD>")
            Next
            SB.AppendLine("</TR>")
        Next
        SB.AppendLine("</TABLE>")
        If IncludeHTMLandBodyTags Then
            SB.AppendLine("</HTML>")
            SB.AppendLine("</BODY>")
        End If
        Return SB.ToString
    End Function

    <Extension()> _
    Public Function ConverTextToXML(ByVal Expression As String) As String
        Dim Value = Expression
        Value = Replace(Value, "&", "&")
        Value = Replace(Value, ">", ">")
        Value = Replace(Value, "<", "<")
        Value = Replace(Value, "'", "&apos;")
        Value = Replace(Value, """", """)
        Return Value
    End Function

    <Extension()> _
    Public Function ToXML(ByVal Expression As DataGridView, Optional ByVal SelectedRowsOnly As Boolean = True, Optional ByVal Title As String = "Export") As String
        Dim SB As New System.Text.StringBuilder

        SB.AppendLine("<?xml version=""1.0""?>")
        'Write Table
        SB.Append(vbTab)
        SB.AppendLine("<TABLE>")

        For Each Row As DataGridViewRow In IIf(SelectedRowsOnly, Expression.SelectedRows, Expression.Rows)
            SB.Append(vbTab)
            SB.Append(vbTab)
            SB.AppendLine("<ROW>")
            For Each Column As DataGridViewColumn In Expression.Columns
                If Column.CellType Is GetType(DataGridViewImageCell) Then
                    GoTo NextColumn
                End If
                Dim ColHeader As String = Column.HeaderText.ConverTextToXML
                ColHeader = Replace(ColHeader, ")", "")
                ColHeader = Replace(ColHeader, "(", "")
                ColHeader = Replace(ColHeader, "/", "")
                ColHeader = Replace(ColHeader, "\", "")
                ColHeader = Replace(ColHeader, "<", "")
                ColHeader = Replace(ColHeader, ">", "")
                ColHeader = Replace(ColHeader, "*", "_")
                ColHeader = Replace(ColHeader, "#", "No")
                ColHeader = Replace(ColHeader, " ", "__")

                SB.Append(vbTab)
                SB.Append(vbTab)
                SB.Append(vbTab)
                SB.Append("<")
                SB.Append(ColHeader)
                SB.Append(">")

                Dim Value = Trim(Row.Cells(Column.Index).FormattedValue.ToString).ConverTextToXML
                'Value = Replace(Value, "&", "&")
                'Value = Replace(Value, ">", ">")
                'Value = Replace(Value, "<", "<")
                'Value = Replace(Value, "'", "&apos;")
                'Value = Replace(Value, """", """)

                Select Case Row.Cells(Column.Index).ValueType.ToString

                    Case GetType(Date).ToString
                        SB.Append(Value)
                    Case GetType(Decimal).ToString()
                        SB.Append(Value)
                    Case GetType(Boolean).ToString
                        SB.Append(Value.ToString)
                    Case Else
                        SB.Append(Value)

                End Select

                SB.Append("</")
                SB.Append(ColHeader)
                SB.Append(">")
                SB.AppendLine()
NextColumn:
            Next
            SB.Append(vbTab)
            SB.Append(vbTab)
            SB.AppendLine("</ROW>")
        Next

        SB.Append(vbTab)
        SB.AppendLine("</TABLE>")
        Return SB.ToString
    End Function

    <Extension()> _
    Public Sub QuickSaveXML(ByVal Expression As DataGridView, ByVal Prefix As String, ByVal OpenWithExcel As Boolean)
        Dim XML = Expression.ToXML(False)


        Dim XML_ExportDir = My.Computer.FileSystem.SpecialDirectories.MyDocuments & "\Exports\"
CreateDir:
        If Not My.Computer.FileSystem.DirectoryExists(XML_ExportDir) Then
            Try
                My.Computer.FileSystem.CreateDirectory(XML_ExportDir)
            Catch ex As Exception
                If MsgBox(ex.Message, MsgBoxStyle.RetryCancel, "Error creating export directory") = MsgBoxResult.Retry Then
                    GoTo CreateDir
                Else
                    Exit Sub
                End If

            End Try

        End If

        Dim ExportFile = XML_ExportDir & Prefix & "-" & Now.ToFileName & ".xml"
        My.Computer.FileSystem.WriteAllText(ExportFile, XML, False)

        If OpenWithExcel Then
            Try
                System.Diagnostics.Process.Start("excel", """" & ExportFile & """")
            Catch ex As Exception
                MsgBox(ex.Message & vbCrLf & "File was still exported to: MyDocuments\Exports", MsgBoxStyle.Exclamation, "Error Opening with excel, is it installed?")
            End Try

        End If

    End Sub



End Module

Here's another example (the above relies on this one)

Imports System.Runtime.CompilerServices

Public Module DateExtensions
    <Extension()> _
    Public Function ToFileName(ByVal expression As Date) As String
        Return expression.Year & "_" & expression.Month & "_" & expression.Day & "-" & expression.Hour & "_" & expression.Minute & "_" & expression.Second

    End Function

    <Extension()> _
Public Function ToFixedWidthString(ByVal expression As Date) As String
        Dim Day As String = ""
        Dim Month As String = ""

        If expression.Day < 10 Then
            Day = "0" & expression.Day
        Else
            Day = expression.Day
        End If

        If expression.Month < 10 Then
            Month = "0" & expression.Month
        Else
            Month = expression.Month
        End If

        Dim Result = Month & "/" & Day & "/" & expression.Year

        Return Result

    End Function

    <Extension()> _
Public Function ToFixedWidthTimeString(ByVal expression As Date) As String
        Dim Hour As String = ""
        Dim Minute As String = ""
        Dim Second As String = ""

        If expression.Hour < 10 Then
            Hour = "0" & expression.Hour
        Else
            Hour = expression.Hour
        End If

        If expression.Minute < 10 Then
            Minute = "0" & expression.Minute
        Else
            Minute = expression.Minute
        End If

        If expression.Second < 10 Then
            Second = "0" & expression.Second
        Else
            Second = expression.Second
        End If

        Dim Result = Hour & ":" & Minute & ":" & Second

        Return Result

    End Function

    <Extension()> _
    Function BusinessDateAdd(ByVal startDate As Date, ByVal days As Integer, _
    Optional ByVal saturdayIsHoliday As Boolean = True) As Date
        Do While days
            ' increment or decrement the date
            startDate = startDate.AddDays(Math.Sign(days))

            ' check that it is a week day
            If startDate.DayOfWeek <> DayOfWeek.Sunday AndAlso (startDate.DayOfWeek _
                <> DayOfWeek.Saturday Or Not saturdayIsHoliday) AndAlso Not startDate.IsHoliday Then


                ' days becomes closer to zero
                days -= Math.Sign(days)
            End If
        Loop
        Return startDate
    End Function

    <Extension()> _
    Function IsHoliday(ByVal Expression As Date) As Boolean

        Dim H = Holidays(Expression)
        Return H.Contains(Expression)

    End Function

    Private Sub AddHoliday(ByVal Result As List(Of Date), ByRef NewYears As Date)
        Select Case NewYears.DayOfWeek
            Case DayOfWeek.Saturday
                NewYears = DateAdd(DateInterval.Day, -1, NewYears)
                Result.Add(NewYears)

            Case DayOfWeek.Sunday
                NewYears = DateAdd(DateInterval.Day, 1, NewYears)
                Result.Add(NewYears)
            Case Else
                Result.Add(NewYears)
        End Select
    End Sub

    <Extension()> _
    Public Function Holidays(ByVal Expression As Date) As List(Of Date)
        Dim Result As New List(Of Date)

        For Y As Integer = Today.Year - 1 To Today.Year + 1

            'New Years
            Dim NewYears As Date = "1/1/" & Y
            AddHoliday(Result, NewYears)

            'Martin Luther King (3RD monday in Jan)
            Dim JanStart As Date = "1/1/" & Y
            Dim JanMondayCount As Integer = 0
            Dim LutherKing As Date

            Do Until JanMondayCount = 3
                If JanStart.DayOfWeek = DayOfWeek.Monday Then
                    LutherKing = JanStart
                    JanMondayCount += 1
                End If
                JanStart = JanStart.AddDays(1)
            Loop

            AddHoliday(Result, LutherKing)


            'Washington Day (3RD monday in Feb)
            Dim FebStart As Date = "2/1/" & Y
            Dim FebMondayCount As Integer = 0
            Dim Washington As Date

            Do Until FebMondayCount = 3
                If FebStart.DayOfWeek = DayOfWeek.Monday Then
                    Washington = FebStart
                    FebMondayCount += 1
                End If
                FebStart = FebStart.AddDays(1)
            Loop

            AddHoliday(Result, Washington)

            'Memorial Day (last Monday of May)
            Dim MayStart As Date = "5/1/" & Y
            Dim MemorialDay As Date

            Do While MayStart.Month = 5
                If MayStart.DayOfWeek = DayOfWeek.Monday Then
                    MemorialDay = MayStart
                End If
                MayStart = MayStart.AddDays(1)
            Loop
            AddHoliday(Result, MemorialDay)


            'Independence Day
            Dim Independence As Date = "7/4/" & Y
            AddHoliday(Result, Independence)


            'Labour Day (First Monday of september)
            Dim SeptStart As Date = "9/1/" & Y
            Dim LabourDay As Date
            Dim LabourDayMatch As Boolean = False

            Do Until LabourDayMatch = True
                If SeptStart.DayOfWeek = DayOfWeek.Monday Then
                    LabourDay = SeptStart
                    LabourDayMatch = True
                    Exit Do
                End If

                SeptStart = SeptStart.AddDays(1)
            Loop
            AddHoliday(Result, LabourDay)


            'Columbus Day (Second Monday of October)
            Dim OctStart As Date = "10/1/" & Y
            Dim OctMonCount As Integer = 0
            Dim Columbus As Date

            Do Until OctMonCount = 2
                If OctStart.DayOfWeek = DayOfWeek.Monday Then
                    Columbus = OctStart
                    OctMonCount += 1
                End If

                OctStart = OctStart.AddDays(1)
            Loop
            AddHoliday(Result, Columbus)


            'Veteran's Day
            Dim Veterans As Date = "11/11/" & Y
            AddHoliday(Result, Veterans)


            'Thanks Giving (last Thursday of November)
            Dim NovStart As Date = "11/1/" & Y
            Dim ThanksGiving As Date

            Do While NovStart.Month = 11
                If NovStart.DayOfWeek = DayOfWeek.Thursday Then
                    ThanksGiving = NovStart
                End If
                NovStart = NovStart.AddDays(1)
            Loop
            AddHoliday(Result, ThanksGiving)

            'Christmas
            Dim Christmas As Date = "12/25/" & Y
            AddHoliday(Result, Christmas)

        Next

        Return Result

    End Function
End Module

This one is a little more advanced (required by some of the above too)

Imports System.Drawing
Imports System.Windows.Forms

Public Class CellColorSetting

    Public Sub New(ByVal ColumnNames As String, ByVal Style As ColorStyle, ByVal ConditionToMatch As Predicate(Of DataGridViewRow))
        _ColumnNames = ColumnNames
        _Style = Style
        _ConditionToMatch = ConditionToMatch
    End Sub

    Private _ColumnNames As String
    Public Property ColumnNames() As String
        Get
            Return _ColumnNames
        End Get
        Set(ByVal value As String)
            _ColumnNames = value
        End Set
    End Property

    Private _ConditionToMatch As Predicate(Of DataGridViewRow)
    Public Property ConditionToMatch() As Predicate(Of DataGridViewRow)
        Get
            Return _ConditionToMatch
        End Get
        Set(ByVal value As Predicate(Of DataGridViewRow))
            _ConditionToMatch = value
        End Set
    End Property

    Private _Style As ColorStyle
    Public Property Style() As ColorStyle
        Get
            Return _Style
        End Get
        Set(ByVal value As ColorStyle)
            _Style = value
        End Set
    End Property


    Private _Templates As DefaultStyles
    Public Property Templates() As DefaultStyles
        Get
            If _Templates Is Nothing Then
                _Templates = New DefaultStyles
            End If
            Return _Templates
        End Get
        Set(ByVal value As DefaultStyles)
            _Templates = value
        End Set
    End Property

    Public Class DefaultStyles

        Private _ErrorStyle As ColorStyle
        Public Property ErrorStyle() As ColorStyle
            Get
                If _ErrorStyle Is Nothing Then
                    Dim MyStyle = New ColorStyle
                    MyStyle.ForeGround = Drawing.Color.Red
                    MyStyle.Background = Drawing.Color.Black
                    MyStyle.SelectionBackground = Drawing.Color.DarkBlue
                    MyStyle.SelectionForeGround = Drawing.Color.Red
                    _ErrorStyle = MyStyle
                    Return _ErrorStyle
                Else
                    Return _ErrorStyle
                End If
            End Get
            Set(ByVal value As ColorStyle)
                _ErrorStyle = value
            End Set
        End Property


        Private _WarningStyle As ColorStyle
        Public Property WarningStyle() As ColorStyle
            Get
                Return _WarningStyle
            End Get
            Set(ByVal value As ColorStyle)
                _WarningStyle = value
            End Set
        End Property


    End Class

End Class