Weird SQL vba issue

[Jehzalahman]

I am using some code I picked up off a website to extract some data from a SQL table into an excel sheet.

It is getting the first four columns fine, but only returning each 512th entry from column 5 (i.e. entry 512, entry 1024 etc.). I have tried it both as a string query and a stored procedure with the same results. Any ideas?

Sub DataExtract()

' Create a connection object.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection
Dim SQLStr As String

' Provide the connection string.
Dim strConn As String

strConn = "Driver={SQL Server};Server=[server];Database=[db];Uid=[ID];Pwd=[PW];"

'Now open the connection.
cnPubs.Open strConn

'Create SQL query
SQLStr = ""
SQLStr = SQLStr & "Select Col1,Col2,Col3,Col4,Col5"
SQLStr = SQLStr & " FROM [table1]"
SQLStr = SQLStr & " WHERE [field]=1 and Col2 not in (select email from [table2])"

' Create a recordset object.
Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset

With rsPubs
' Assign the Connection object.
.ActiveConnection = cnPubs
' Extract the required records.
.Open SQLStr
' Copy the records into cell A1 on Sheet1.
Sheets("SQL Returns").Range("A1").CopyFromRecordset rsPubs

' Tidy up
.Close
End With

cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing

End Sub

 

[Nashprojects]

Depending which version of excel vba and sql you are using this is a known issue!

I have a work around however its very slow but its reliable and thats the main thing...


After you have sent the query you simply just loop through the columns and rows of data and put the values into the cells... I said it was slow!!
After years of working with sql and vba I use this method as its reliable... I just generally have my programs automated and ran on servers so it doesn't impact on my time.


Sub ConnectSQLExcel()

Dim strLogin As String, strPass As String, strHost As String
Dim strDb As String, strTable As String, strMsg As String, strSQL As String
On Error GoTo ErrorHandler

Workbooks(sMacroBook).Sheets("output").Cells.ClearContents
Workbooks(sMacroBook).Sheets("output2").Cells.ClearContents
DoEvents

'rst is my recordset and cnt is my connection

rst.Open sSql, cnt
rst.MoveFirst
sOutputsheet = "output"
iCol = 1
dRow = 1
Do Until iCol > rst.Fields.Count
Workbooks(sMacroBook).Sheets("output").Cells(dRow, iCol) = rst.Fields(iCol - 1).Name
Workbooks(sMacroBook).Sheets("output2").Cells(dRow, iCol) = rst.Fields(iCol - 1).Name
iCol = iCol + 1
Loop
'rst.MoveFirst
dRow = 2
Do Until rst.EOF
iCol = 1
Do Until iCol > rst.Fields.Count
Select Case ReturnDataType(rst.Fields(iCol - 1).Type)
Case "INTEGER"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol).NumberFormat = "0"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol) = Format(rst.Fields(iCol - 1).Value, "0")
Case "DOUBLE"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol).NumberFormat = "#,##0.00;[RED](#,##0.00"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol) = Format(rst.Fields(iCol - 1).Value, "#,##0.00")
Case "TEXT"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol).NumberFormat = "@"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol) = rst.Fields(iCol - 1).Value
Case "BOOLEAN"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol).NumberFormat = "@"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol) = rst.Fields(iCol - 1).Value
Case "DATE"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol).NumberFormat = "dd-mmm-yyyy"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol) = Format(rst.Fields(iCol - 1).Value, "dd-mmm-yyyy")
Case "DECIMAL"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol).NumberFormat = "#,##0.00;[RED](#,##0.00)"
Workbooks(sMacroBook).Sheets(sOutputsheet).Cells(dRow, iCol) = Format(rst.Fields(iCol - 1).Value, "#,##0.00")
End Select
Cells(dRow, 1).Select
iCol = iCol + 1
Loop
rst.MoveNext
dRow = dRow + 1
If dRow = 65536 Then
sOutputsheet = "output2"
dRow = 2
End If
Loop
Endit:
On Error Resume Next
rst.Close
Set rst = Nothing
cnt.Close
Set cnt = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume Endit
End Sub



Function ReturnDataType(num)
Select Case num
Case 3, 129
'number
ReturnDataType = "INTEGER"
Case 5
ReturnDataType = "DOUBLE"
Case 130, 202, 203, 200
'text
ReturnDataType = "TEXT"
Case 11
ReturnDataType = "BOOLEAN"
Case 7, 135
'date
ReturnDataType = "DATE"
Case 131
'decimal
ReturnDataType = "DECIMAL"
Case Else
MsgBox "Data type not found " & num
End Select
End Function


This was built in excel 2003 hence the 65536 limit...