Большая часть кода из этого урока:
https://www.excel -sql-server.com / первенствует-SQL-сервер-импорт-экспорт с использованием-vba.htm
Мне удалось импортировать нужную таблицу из моей БД, чтобы превзойти ее на новом листе.
Однако я заметил, что на листе отсутствует + - 230 строк, которые присутствуют в таблице БД. Глядя на код, я не вижу реальной причины, по которой он не импортирует всю таблицу. Я надеюсь, что кто-то здесь сможет указать на любую ошибку / ошибку.
Код:
Функции:
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
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
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