Access到Excel中的唯一项目

时间:2014-05-28 18:02:16

标签: sql excel combobox

我有这段代码:

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

现在我将单元格中的第一个project1作为值,但我应该有两个独特的project1。我怎么去第二个? 非常感谢第一条评论,SQL至少现在正在执行,但没有发回两个project1项

2 个答案:

答案 0 :(得分:0)

您有 Dim 'ed rs ,但从未设置 rs

答案 1 :(得分:0)

我在VBA中运行SQL时做了一些事情:

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

然后用于:

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