[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 716
  • Last Modified:

Excel VBA/VB.net Recordsets Accesss & SQL databases

Hi

I am migrating an Excel VBA project that work with a backend Access database to a VB.net Excel Add-in that interacts with Access and SQL. The original project code uses Recordsets (as shown in the code below), which the project sponsor would like me to use in VB.net. Is this even possible (given that I need to interact with SQL as well as Access). I usually use ADO.net.


Sub RefreshList()
    'On Error Resume Next
     
    With Me.Lst_Empl
           .BoundColumn = 1
           .ColumnCount = 7
           .ColumnHeads = False
           .TextColumn = True
           .ColumnWidths = 5
           .ListStyle = fmListStyleOption
           .ColumnWidths = "100,100,60,50"
    End With
   
    Lst_Empl.Clear
    Call RSConnect
    If RSSupp.EOF Then
        'MsgBox "No Supplier Data or Recordset Lost"
        Exit Sub
    End If
   
    RSSupp.MoveFirst
    Do While Not RSSupp.EOF
    Lst_Empl.AddItem RSSupp.Fields("First_Name")
    If IsNull(RSSupp.Fields("Last_Name")) Then
        Lst_Empl.Column(1, Lst_Empl.ListCount - 1) = ""
    Else
        Lst_Empl.Column(1, Lst_Empl.ListCount - 1) = RSSupp.Fields("Last_Name").Value
    End If
   
    If IsNull(RSSupp.Fields("Employee_Type")) Then
    Else
        Lst_Empl.Column(2, Lst_Empl.ListCount - 1) = RSSupp.Fields("Employee_Type").Value
    End If
   
    If IsNull(RSSupp.Fields("Active")) Then
    Else
        Lst_Empl.Column(3, Lst_Empl.ListCount - 1) = RSSupp.Fields("Active").Value
    End If
   
    If IsNull(RSSupp.Fields("Waiter Number")) Then
    Else
        Lst_Empl.Column(4, Lst_Empl.ListCount - 1) = RSSupp.Fields("Waiter Number").Value
    End If
    If IsNull(RSSupp.Fields("EmployeeID")) Then
    Else
        Lst_Empl.Column(5, Lst_Empl.ListCount - 1) = RSSupp.Fields("EmployeeID").Value
    End If
   
    RSSupp.MoveNext
    Loop
   
End Sub
0
Murray Brown
Asked:
Murray Brown
  • 3
1 Solution
 
YZlatCommented:
Don't use recordset in .NET, use ADo.NET
0
 
YZlatCommented:
What is Lst_Empl?
0
 
YZlatCommented:
try something like this:

 Sub RefreshList()
        'On Error Resume Next

        'With Me.Lst_Empl
        '    .BoundColumn = 1
        '    .ColumnCount = 7
        '    .ColumnHeads = False
        '    .TextColumn = True
        '    .ColumnWidths = 5
        '    .ListStyle = fmListStyleOption
        '    .ColumnWidths = "100,100,60,50"
        'End With

        Lst_Empl.Items.Clear()

        Lst_Empl.Columns.Clear()

        Lst_Empl.Columns.Add(New ColHeader("First Name", 50, HorizontalAlignment.Left, True))
        Lst_Empl.Columns.Add(New ColHeader("Last Name", 50, HorizontalAlignment.Left, True))
        Lst_Empl.Columns.Add(New ColHeader("Type", 50, HorizontalAlignment.Left, True))
        Lst_Empl.Columns.Add(New ColHeader("Active", 50, HorizontalAlignment.Left, True))
        Dim ds As New DataSet
        Dim sql, strConn As String
        Dim i As Integer
        strConn = ""
        sql = "SELECT EmployeeID, First_Name, Last_Name, Employee_Type, Active FROM Employees"
        ds = GetSQLDataSet(strConn, sql)
        If ds.Tables.Count > 0 Then

            If ds.Tables(0).Rows.Count > 0 Then

                For i = 0 To ds.Tables(0).Rows.Count - 1
                    Dim lvi As ListViewItem
                    lvi = New ListViewItem()
                    lvi.Tag = ds.Tables(0).Rows(i)("EmployeeID")
                    lvi.Text = ds.Tables(0).Rows(i)("Last_Name")
                    Lst_Empl.Items.Add(lvi)

                    lvi.SubItems.Add(ds.Tables(0).Rows(i)("First_Name"))
                    lvi.SubItems.Add(ds.Tables(0).Rows(i)("Employee_Type"))
                    lvi.SubItems.Add(ds.Tables(0).Rows(i)("Active"))
                Next
            End If
        End If
       
       
    End Sub

Function GetSQLConnection(ByVal strConn As String) As SqlConnection
        Dim conn As SqlConnection
        Try
            conn = New SqlConnection(strConn)
            conn.Open()
        Catch ex As SqlException
            Console.Write("SQL ERROR: " & ex.Message)
        Catch ex As Exception
            Console.Write("ERROR: " & ex.Message)
        End Try
        GetSQLConnection = conn
    End Function
    Function GetSQLDataSet(ByVal strConn As String, ByVal query As String) As DataSet
        Dim conn As SqlConnection
        Dim dset As New DataSet
        Try
            conn = GetSQLConnection(strConn)
            Dim da As SqlDataAdapter = New SqlDataAdapter(query, conn)
            ''make sure command does not timeout
            da.SelectCommand.CommandTimeout = 0
            ''fill dataset
            da.Fill(dset)
        Catch ex As SqlException
            Console.Write("SQL ERROR: " & ex.Message)
        Catch ex As Exception
            Console.Write("ERROR: " & ex.Message)
        Finally
            If conn.State = ConnectionState.Open Then
                conn.Close()
            End If
        End Try
        GetSQLDataSet = dset
    End Function

Open in new window


and you will also need the following class:

Public Class ColHeader
    Inherits ColumnHeader
    Public ascending As Boolean
    Public Sub New(ByVal text As String, ByVal width As Integer, ByVal align As HorizontalAlignment, ByVal asc As Boolean)
        Me.Text = text
        Me.Width = width
        Me.TextAlign = align
        Me.ascending = asc
    End Sub
End Class

Open in new window

0
 
Murray BrownMicrosoft Cloud Azure/Excel Solution DeveloperAuthor Commented:
Thanks very much
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now