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

问题描述

许多代码来自本教程:

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

我已经成功地从数据库中导入了所需的表格，以将Excel精简到新的工作表上.

I have successfully managed to import the desired table from my DB to excel onto a new worksheet.

但是，我注意到DB表中存在+-230行从工作表中丢失.看代码，我看不出为什么它不会导入整个表的任何真正原因.我希望这里的人能够指出任何错误/错误.

However, I have noticed that there are +- 230 lines missing from the sheet, that are present in the DB table. Looking at the code, I don't see any real reason as to why it would not import the entire table. I am hoping someone here will be able to point out any mistake/error.

代码:

功能:

ImportSQLtoQueryTable

ImportSQLtoQueryTable

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

StringToArray

StringToArray

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

GetTestConnectionString

GetTestConnectionString

Function GetTestConnectionString() As String

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

End Function

OleDbConnectionString

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

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

推荐答案

问题出在此行的 TestImportUsingQueryTable 子目录中:

The issue was in the TestImportUsingQueryTable sub on this line:

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

并在此行的 GetTestConnectionString 函数中:

1. 连接类型"，_

这些是指向MASTER DB的，而不是针对这种情况我需要的特定DB，并且它们在211行之前都具有相同的数据.

These were pointing to the MASTER DB and not to specific DB I needed for this scenario and they BOTH had the same data up to line 211.

更新的代码:

在 TestImportUsingQueryTable 子菜单中:

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

:

Function GetTestConnectionString() As String

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

End Function

这篇关于VBA-将SQL中的所有行从表导入到Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！