Excel VBA Challenged

[jstevens]

I am using this bit of code to extract data from a MS SQL database: table names and record count of each table It works if I create a new query in SSMS and run the code. My challenge is when I run it using Excel VBA and try to copy the recordset to a spreadsheet.

I receive an error on "rs.Open SQLStr, cn, adOpenStatic: A cursor with the name 'table_cursor' already exists.

SQLStr is a string relative to the SSMS query.

If there is a different approach obtaining a database's tables and record count of each table I'm open to suggestions.

The VBA code goes something like this:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

Set cn = New ADODB.Connection
cn.Open "Provider=MSOLEDBSQL;Data Source=" & Server_Name_Target & ";Initial Catalog=" & DatabaseName & ";User ID=" & User_ID & ";Password=" & Password_Target & ";"

cn.Execute SQLStr
rs.Open SQLStr, cn, adOpenStatic

...more code

Code: Select all

-- This is the SSMS query script
DECLARE @DatabaseName NVARCHAR(128) = 'YourDatabaseName' -- Replace 'YourDatabaseName' with your actual database name
DECLARE @DynamicSQL NVARCHAR(MAX) -- Use a different variable to store the dynamic SQL script

-- Dynamically build SQL script including the USE statement
SET @DynamicSQL = 'USE ' + QUOTENAME(@DatabaseName) + '; -- Switch to the specified database
           CREATE TABLE #TableCounts
           (
               TableName NVARCHAR(128),
               RecordCount INT
           )
           
           DECLARE @TableName NVARCHAR(128)

           -- Cursor to iterate through table names
           DECLARE table_cursor CURSOR FOR
           SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_TYPE = ''BASE TABLE''

           OPEN table_cursor

           FETCH NEXT FROM table_cursor INTO @TableName

           WHILE @@FETCH_STATUS = 0
           BEGIN
               -- Dynamic SQL to count records in each table
               DECLARE @InnerSQL NVARCHAR(MAX)
               SET @InnerSQL = ''INSERT INTO #TableCounts (TableName, RecordCount) SELECT '''''' + @TableName + '''''', COUNT(*) FROM '' + @TableName
               EXEC sp_executesql @InnerSQL
               FETCH NEXT FROM table_cursor INTO @TableName
           END

           CLOSE table_cursor
           DEALLOCATE table_cursor

           -- Select the record counts from #TableCounts
           SELECT * FROM #TableCounts'

-- Execute the dynamically built SQL script
EXEC sp_executesql @DynamicSQL

[jstevens]

I found a solution. Sometimes walking away for a bit helps.

Code: Select all

Sub GetTableRecords()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim ws As Worksheet
    Dim i As Long, j As Long
    
    
    DeclareVariables
    
    ' Create a new Connection object
    Set conn = CreateObject("ADODB.Connection")
    
    ' Set up connection string
    conn.ConnectionString = "Provider=MSOLEDBSQL;Data Source=" & Server_Name_Target & ";Initial Catalog=" & DatabaseName & ";User ID=" & User_ID & ";Password=" & Password_Target & ";"
    
    ' Open the connection
    conn.Open
    
    ' Set up SQL query to retrieve table names and record counts
    strSQL = "SELECT t.name AS TableName, i.rows AS Records" & _
             " FROM sysobjects t, sysindexes i" & _
             " WHERE t.xtype = 'U' AND i.id = t.id AND i.indid IN (0,1)" & _
             " ORDER BY TableName;"
    
    ' Create a new Recordset object
    Set rs = CreateObject("ADODB.Recordset")
    
    ' Execute SQL statement
    rs.Open strSQL, conn
    
    ' Set a reference to the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' Copy recordset data to Excel range
    For i = 0 To rs.Fields.Count - 1
        ws.Cells(3, i + 5).Value = rs.Fields(i).Name ' Column headers
    Next i
    
    ' Data rows
    j = 4 ' Start row for data
    Do While Not rs.EOF
        For i = 0 To rs.Fields.Count - 1
            ws.Cells(j, i + 5).Value = rs.Fields(i).Value
        Next i
        rs.MoveNext
        j = j + 1
    Loop
    
    ' Close the recordset
    rs.Close
    
    ' Close the connection
    conn.Close
    
    ' Clean up
    Set rs = Nothing
    Set conn = Nothing
End Sub

[snb]

Probably sufficient:

Code: Select all

Sub M_snb()
  With CreateObject("ADODB.recordset")
    .Open "SELECT t.name AS TableName, i.rows AS Records FROM sysobjects t, sysindexes i WHERE t.xtype = 'U' AND i.id = t.id AND i.indid IN (0,1) ORDER BY TableName;", "Provider=MSOLEDBSQL;Data Source=" & Server_Name_Target & ";Initial Catalog=" & DatabaseName & ";User ID=" & User_ID & ";Password=" & Password_Target & ";"
    Sheet1.Cells(1).CopyFromRecordset .DataSource
    .Close
  End With
End Sub

[jstevens]

snb,

Thanks for your suggestion.