With much of the code coming from this tutorial:
https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm
I have successfully managed to import the desired table from my DB to excel onto a new worksheet.
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.
Code:
Functions:
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
The main Sub:
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
The issue was in the
TestImportUsingQueryTable
sub on this line:query = "SELECT * FROM master.dbo.kw_keyword_tbl"
And in the
GetTestConnectionString
Function on this line:"Connection type", _
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.
Updated Code:
In the
TestImportUsingQueryTable
sub:query = "SELECT * FROM db1.dbo.kw_keyword_tbl"
in the
GetTestConnectionString
Function: