Как отформатировать данные, вставленные с сервера SQL в таблицу Excel, используя VBA?

Question

Я использую приведенный ниже код для импорта таблиц с сервера SQL в Excel. Таким образом, старые данные будут удалены, а новые будут вставлены. Мне нужно вставить таблицу для связанных данных. Я нашел что-то под названием ListObject, но я не знал, как это применить. Есть ли способ вставить таблицу после вставки данных?

Option Explicit

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset

Sub Connect_To_SQLServer(ByVal Server_Name As String, ByVal Database_Name As String, ByVal SQL_Statement As String)
Dim strConn As String
Dim wsReport As Worksheet
Dim col As Integer
Dim tbl As ListObject

strConn = "Provider=SQLOLEDB;"
strConn = strConn & "Server=" & Server_Name & ";"
strConn = strConn & "Database=" & Database_Name & ";"
strConn = strConn & "Trusted_Connection=yes;"

Set conn = New ADODB.Connection
With conn
        .Open ConnectionString:=strConn
        .CursorLocation = adUseClient
End With

Set rst = New ADODB.Recordset
With rst
        .ActiveConnection = conn
        .Open Source:=SQL_Statement

End With
'// here i selected the sheet where the data will be written 
Set wsReport = Sheets("RDWH")
With wsReport
'// here I clear the old data and insert new set
        wsReport.Select
        Selection.Clear
        For col = 0 To rst.Fields.Count - 1
                .Cells(1, col + 1).Value = rst.Fields(col).Name
        Next col

        .Range("A2").CopyFromRecordset rst


End With

Set wsReport = Nothing

Call Close_Connections

End Sub

Private Sub Close_Connections()

If rst.State <> 0 Then rst.Close
If conn.State <> 0 Then conn.Close

'// Release Memory
Set rst = Nothing
Set conn = Nothing

End Sub

Sub Run_Report()
Dim Server_Name As String

Server_Name = "NL-1012716\SQLEXPRESS"

Call Connect_To_SQLServer(Server_Name, "project", "SELECT * FROM [2_RDWH_CAST]")
End Sub

Answer 1

Проще, если имя листа совпадает с именем таблицы, и просто удалить любой лист с таким именем. Затем воссоздайте лист с новой таблицей. В этом примере показано, как можно загрузить несколько таблиц за одну операцию с каждым запросом, создавая новый лист.

- Обновить; В подпункт Run_Report добавлены параметры имени и положения листа.

    Option Explicit

    Sub Run_Reports()

        Dim conn As ADODB.Connection
        Const SERVER_NAME As String = "NL-1012716\SQLEXPRESS"
        Const DB_NAME = "test"

        Dim sTable As String
        sTable = ThisWorkbook.Sheets("Control").Range("H6").Value

        ' connect to DB, run reports and disconnect
        Set conn = Connect_To_SQLServer(SERVER_NAME, DB_NAME)
        Call Run_Report(conn, sTable, "Sheet3", "A3")
        conn.Close
        Set conn = Nothing

    End Sub


    Sub Run_Report(ByRef conn As ADODB.Connection, ByVal TABLE_NAME As String, _
                   SHEET_NAME As String, START_CELL As String)

        If Len(TABLE_NAME) = 0 Then
            MsgBox "TABLE_NAME missing", vbCritical, "ERROR"
            Exit Sub
        End If

        Dim rst As ADODB.Recordset
        Dim wb As Workbook, ws As Worksheet, i As Integer
        Dim wsReport As Worksheet, tblResult As ListObject

        ' query
        Dim SQL As String
        SQL = "SELECT * FROM [" & TABLE_NAME & "]"

        ' execute query
        Set rst = New ADODB.Recordset
        With rst
            .ActiveConnection = conn
            .Open Source:=SQL
        End With

        ' output
        Set wb = ThisWorkbook

        ' clear sheet
        Set wsReport = wb.Sheets(SHEET_NAME)
        wsReport.Cells.Clear

        With wsReport.Range(START_CELL)
            ' write headers
            For i = 0 To rst.Fields.Count - 1
                .Offset(0, i).Value = rst.Fields.Item(i).Name
            Next
            ' write data
            .Offset(1, 0).CopyFromRecordset rst
            ' create table
            Set tblResult = wsReport.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes)
            ' add table name
            .Offset(-1, 0) = TABLE_NAME
        End With
        MsgBox "Rows written = " & rst.RecordCount, vbInformation, TABLE_NAME

        rst.Close
        Set rst = Nothing

    End Sub

    Function Connect_To_SQLServer(SERVER_NAME As String, DB_NAME As String) As ADODB.Connection

        Dim strConn As String
        strConn = "Provider=SQLOLEDB;" & _
                  "Server=" & SERVER_NAME & ";" & _
                  "Database=" & DB_NAME & ";" & _
                  "Trusted_Connection=yes;"

        Set Connect_To_SQLServer = New ADODB.Connection
        With Connect_To_SQLServer
            .Open ConnectionString:=strConn
            .CursorLocation = adUseClient
        End With

    End Function