时间戳

首页 > 解决方案 > VBA - 将 SQL 表中的所有行导入 Excel

sql - VBA - 将 SQL 表中的所有行导入 Excel

问题描述

大部分代码来自本教程：

https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm

我已经成功地将所需的表从我的数据库中导入到一个新的工作表中。

但是，我注意到表格中缺少 +- 230 行，这些行存在于 DB 表中。查看代码，我看不出它为什么不导入整个表的任何真正原因。我希望这里有人能够指出任何错误/错误。

代码：

功能：

导入 SQL 到查询表

Function ImportSQLtoQueryTable(ByVal conString As String, ByVal query As String, ByVal target As Range) As Integer

    Dim ws As Worksheet
    Set ws = target.Worksheet

    Dim address As String
    address = target.Cells(1, 1).address

    'Procedure recreates ListObject or QueryTable
    'For Excel 2007 or higher
    If Not target.ListObject Is Nothing Then

        target.ListObject.Delete

    'For Excel 2003
    ElseIf Not target.QueryTable Is Nothing Then

        target.QueryTable.ResultRange.Clear
        target.QueryTable.Delete

    End If

    'For 2007 or higher
    If Application.Version >= "12.0" Then

        With ws.ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;" & conString), Destination:=Range(address))

            With .QueryTable

                .CommandType = xlCmdSql
                .CommandText = StringToArray(query)
                .BackgroundQuery = True
                .SavePassword = True
                .Refresh BackgroundQuery:=False

            End With

        End With

    'For Excel 2003
    Else

        With ws.QueryTables.Add(Connection:=Array(conString), Destination:=Range(address))

            .CommandType = xlCmdSql
            .CommandText = StringToArray(query)
            .BackgroundQuery = True
            .SavePassword = True
            .Refresh BackgroundQuery:=False

        End With

    End If

    ImportSQLtoQueryTable = 0

End Function

字符串到数组

Function StringToArray(Str As String) As Variant

    Const StrLen = 127
    Dim NumElems As Integer
    Dim Temp() As String
    Dim i As Integer

    NumElems = (Len(Str) / StrLen) + 1
    ReDim Temp(1 To NumElems) As String

    For i = 1 To NumElems

       Temp(i) = Mid(Str, ((i - 1) * StrLen) + 1, StrLen)

    Next i

    StringToArray = Temp

End Function

获取测试连接字符串

Function GetTestConnectionString() As String

    GetTestConnectionString = OleDbConnectionString( _
        "Server Location", _
        "Connection type", _
        "Username", _
        "Password")

End Function

OleDbConnectionString

Function OleDbConnectionString(ByVal Server As String, ByVal Database As String, ByVal Username As String, ByVal Password As String) As String

    If Username = "" Then

        MsgBox "User name for DB login is blank. Unable to Proceed"

    Else
        OleDbConnectionString = _
        "Provider=SQLOLEDB.1;" & _
        "Data Source=" & Server & "; " & _
        "Initial Catalog=" & Database & "; " & _
        "User ID=" & Username & "; " & _
        "Password=" & Password & ";"
    End If

End Function

主副：

TestImportUsingQueryTable

Sub TestImportUsingQueryTable()

    Dim conString As String, query As String
    Dim DestSh As Worksheet
    Dim tmpltWkbk As Workbook
    Dim target As Range

    'Set workbook to be used
    Set tmpltWkbk = Workbooks("Template.xlsm")

    'Need to add check if sheet already exists
    'If sheet already exists then just refresh table

    'Add a new sheet called "DB Table"
    Set DestSh = tmpltWkbk.Worksheets.Add
    DestSh.Name = "DB Table"

    With DestSh

        .UsedRange.Clear
        Set target = .Cells(2, 2)

    End With

    'Get connection string
    conString = GetTestConnectionString()

    'Set Query to table
    query = "SELECT * FROM master.dbo.kw_keyword_tbl"

    Select Case ImportSQLtoQueryTable(conString, query, target)

        Case Else

    End Select

End Sub

标签： sqlsql-serverexcelvba

解决方案

问题出TestImportUsingQueryTable在这一行的 sub 中：

  1. query = "SELECT * FROM master.dbo.kw_keyword_tbl"

在这一行的GetTestConnectionString函数中：

  1. "Connection type", _

这些指向主数据库，而不是我在这种情况下需要的特定数据库，并且它们在第 211 行之前都有相同的数据。

更新代码：

在TestImportUsingQueryTable子中：

query = "SELECT * FROM db1.dbo.kw_keyword_tbl"

在GetTestConnectionString函数中：

Function GetTestConnectionString() As String

    GetTestConnectionString = OleDbConnectionString( _
        "Server Location", _
        "db1", _
        "Username", _
        "Password")

End Function

推荐阅读