Skip to content

Instantly share code, notes, and snippets.

@spences10
Created April 27, 2017 08:43
Show Gist options
  • Save spences10/bfe7d58288ede364eb89d26727779d7d to your computer and use it in GitHub Desktop.
Save spences10/bfe7d58288ede364eb89d26727779d7d to your computer and use it in GitHub Desktop.
Excel Recordset from Sheet
Public Function RecordSetFromSheet(sheetName As String)

Dim rst As New ADODB.Recordset
Dim cnx As New ADODB.Connection
Dim cmd As New ADODB.Command

    'setup the connection
    '[HDR=Yes] means the Field names are in the first row
    With cnx
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
        .Open
    End With

    'setup the command
    Set cmd.ActiveConnection = cnx
    cmd.CommandType = adCmdText
    cmd.CommandText = "SELECT * FROM [" & sheetName & "$]"
    rst.CursorLocation = adUseClient
    rst.CursorType = adOpenDynamic
    rst.LockType = adLockOptimistic

    'open the connection
    rst.Open cmd

    'disconnect the recordset
    Set rst.ActiveConnection = Nothing

    'cleanup
    If CBool(cmd.State And adStateOpen) = True Then
        Set cmd = Nothing
    End If

    If CBool(cnx.State And adStateOpen) = True Then cnx.Close
    Set cnx = Nothing

    '"return" the recordset object
    Set RecordSetFromSheet = rst

End Function

Public Sub Test()

  Dim rstData As ADODB.Recordset
  Set rstData = RecordSetFromSheet("Sheet1")

  Sheets("Sheet2").Range("A1").CopyFromRecordset rstData

End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment