Unique items from Access to Excel - sql

Question

I have this code:
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Set cn = CreateObject("ADODB.Connection")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=\\lm\central\Permkt\Svc02-User-Disk\Sales\Sales-Private\Consumer Marketing\Marketing Analytics\Testing Framework\2014Data.accdb"
strSql = "SELECT distinct project1 FROM 2014Data"
cn.Open strConnection
Set rs = cn.Execute(strSql)
rw = 1
For Each myfield In rs.Fields
Cells(rw, 7) = myfield
rw = rw + 1
Next myfield
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
And now i am getting the first project1 in the cell as a value, but I should have two unique project1's . How would I get to the second?
Thanks so much for the first comments, the SQL is at least now executing but not sending back both project1 items

Answer 1

You have Dim'ed rs,but never Set rs

Answer 2

I did some stuff on running SQL within VBA:
Public Sub GetCn(ByRef dbcon As ADODB.Connection, ByRef dbrs As ADODB.Recordset, _
sqlstr As String, servername As String, dbname As String)
Set dbcon = New ADODB.Connection
dbcon.CursorLocation = adUseClient
dbcon.Open "Provider=SQLNCLI;Server=" & servername & ";Database=" & dbname & ";Trusted_Connection=yes;"
'"PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbfile & ";", _
'usernm , pword
Set dbrs = New ADODB.Recordset
'Debug.Print sqlstr
dbcon.CommandTimeout = 200
Debug.Print sqlstr
dbrs.Open sqlstr, dbcon
End Sub
Public Sub RunSQL(sql As String)
Dim adoconn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim dbname As String
Dim servername As String
servername = Worksheets("DBSettings").Range("B1").value
dbname = Worksheets("DBSettings").Range("B2").value
Call GetCn(adoconn, adors, sql, servername, dbname)
End Sub
Sub OpenDatabaseConnection(ByVal servername As String, ByVal databasename As String, sql As String, myRange As Range)
Dim connectionstring As String
'Dim SQL As String
Dim adoconn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim dbname As String
If servername = "" Then servername = Worksheets("DBSettings").Range("B1").value
If databasename = "" Then databasename = Worksheets("DBSettings").Range("B2").value
Call GetCn(adoconn, adors, sql, servername, databasename)
NrOfRows = adors.RecordCount
myRange.CopyFromRecordset adors
'LOOP DOOR KOLOMMEN en OUTPUT Columns 1 rij hoger
Dim fieldname As String, counter As Integer
counter = 1
Dim StartRange As Range
Set StartRange = myRange.Worksheet.Range("A1")
For Each Field In adors.Fields
StartRange.Cells(1, counter).value = Field.name
counter = counter + 1
Next
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
Dim sn() As Variant, wsnn As String
wsnn = myRange.Worksheet.name
sn = Array(wsnn)
'Call NameDeletionV3(sn)
'Call CreateName("RawData", CreateRange(Worksheets(sn), CInt(1), GetLastColumn(Worksheets(sn)), CInt(1), GetLastRow(Worksheets(sn))), Worksheets(sn))
'myRange = Worksheets("Q1-old").Range("B1")
End Sub
and then for usage:
Sub SQL_Execute()
Dim sql As String, FromDate As Date, EndDate As Date
sql = "SELECT * FROM TABLENAME"
Dim myRange As Range
Dim sheetname As String: sheetname = "Sheet1"
Worksheets(sheetname).Cells.Delete
Set myRange = Worksheets(sheetname).Range("A2")
Debug.Print sql
Call OpenDatabaseConnection("", "", sql, myRange)
End Sub