2016-12-30 100 views
2

爲什麼此代碼無法工作?對不起,通用的問題....從電子表格和Access數據庫獲取用戶ID

我的任務是生成報告與參考信息,需要從訪問數據庫和Excel電子表格中繪製。

基本上我的角色是負責爲住在社區的人提供服務;我提供服務的所有人的記錄都包含在訪問數據庫中。有參考資料;地址,姓名,情況以及定期向出資人或董事會報告所需的其他信息。

我也爲當地企業提供服務;此信息包含在電子表格中,而不是數據庫。這些信息可以放入關係數據庫中,並將這兩者聯繫起來;但是組織對系統進行重大改變存在阻力,也沒有真正瞭解如何做到這一點。

因此,我正在努力推進一個電子表格 - 如果我向人員A或組織B提供服務,則此電子表格將同時檢查訪問數據庫和Excel電子表格,以查看是否輸入了該人員或組織;如果是的話,它應該使用該信息填充表格,併爲其分配唯一的代碼。

唯一代碼是基於數據庫確定的;無論該個人或組織是否已被輸入到數據庫中。

我在與基地工作的表格是這樣的:

enter image description here

底部的表,我希望是一個「查找」表。它的名字是Lookup。我想用它運行的代碼看起來像這樣(但OBV不會是這樣):

Sub getUserID() 

    Dim myTable As ListObject 


    Set myTable = Sheets("Client Codes").ListObjects("Lookup") 
     If myTable.ListRows.Count >= 1 Then 
      myTable.DataBodyRange.Delete 
     End If 

With Sheets("Client Codes").ListObjects("Lookup").Add(SourceType:=0, Source:=Array(Array("ODBC;DSN=MS Access Database;DBQ=C:\database\here\test.accdb;DefaultDir=F:\Housing;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeo"), Array("ut=5;")), Destination:=myTable.Range(Cells(1, 1))) 
    .CommandText = Array("SELECT Clients.ID, Clients.LastName, Clients.FirstName " & Chr(13) & "" & Chr(10) & "FROM `C:\database\here\test.accdb`.Clients Clients" & Chr(13) & "" & Chr(10) & "WHERE (Clients.LastName='" & Range("b1").End(xlDown) & "') AND (Clients.FirstName='" & Range("c1").End(xlDown) & "')") 
End With 

With Sheets("Client Codes").ListObjects("Lookup").Add(SourceType:=0, Source:=Array(Array("ODBC;DSN=Excel Files;DBQ=C:\spreadsheet\here\text.xlsx;DefaultDir=c:\spreadsheet;DriverId=1046;MaxBufferSize=2"), Array("048;PageTimeout=5;")), Destination:=myTable.Range(Cells(1, 1))) 
    .CommandText = Array("SELECT `Businesses$`.Operation" & Chr(13) & "" & Chr(10) & "FROM `C:\spreadsheet\here\test.xlsx`.`Businesses$` `Businesses$`" & Chr(13) & "" & Chr(10) & "WHERE (`Businesses$`.Operation='" & Range("b1").End(xlDown) & "')") 

End With 
End Sub 

的希望是能夠查詢任何一個人的姓和名,或爲基礎的數據庫根據組織名稱查詢電子表格;並且如果找到了一個值,則向表'Lookup'添加一些信息。如果沒有找到,那麼我會知道它有一個新的條目,並輸入這樣的信息。

作爲參考,數據庫有3個字段(ID,姓氏,名字);並且電子表格有1列(操作)。

真正的混亂這裏集中:

  1. 如何「添加」基於查詢到的ListObject到預先存在的表中的信息
  2. 如何做到這一點既與訪問數據庫和一個Excel電子表格

任何建議在其他方式如何做到這一點,將不勝感激;從多個數據源中提取信息到一個表中,以便在該表中進行驗證。

編輯:如果我通過Access或其他數據庫程序來做到這一點,我會在兩張桌子上做一個INNERJOIN;一個人,另一個企業。我期望保持卓越,但我發現它更加用戶友好。

編輯:代碼基於伊恩的迴應....生成以下錯誤信息: 「運行時錯誤-2147467259,無法找到可安裝ISAM」

研究互聯網似乎表明以下幾點: 1)人們 2之前獲得這樣的錯誤)有可能不是一個正確的DLL安裝 - 不確定是這種情況,因爲我試圖訪問從Excel中訪問,並且似乎並不存在這裏訪問的DLL:https://support.microsoft.com/en-us/kb/209805 3)可能存在連接字符串被陷害。數據源可能需要用引號括起來,JET OLEDB需要使用而不是ACE,連接字符串需要擴展以包含'擴展屬性':Error: "Could Not Find Installable ISAM"

最後一個顯然是最大的目標有關於它的最多錯誤)。

Option Explicit 
Sub getUserID() 


    Dim cmd As New ADODB.Command 
    Dim conn As New ADODB.Connection 
    Dim rs As New ADODB.Recordset 
    Dim strConn As String 
    Dim strSQL As String 
    Dim firstName As String 
    Dim lastName As String 


    firstName = "John" 
    lastName = "Smith" 

    strConn = "Provider = Microsoft.ACE.OLEDB.12.0;'DataSource=F:\Housing\bpTest.accdb'" 


    conn.Open strConn 

    strSQL = "SELECT * FROM Table Where FirstName = '" & firstName & "' AND LastName = '" & lastName & "';" 


    '& ... ' or You could put your InnerJoin SQL here 

    rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic 

    If rs.EOF Then 'If the returned RecordSet is empty 

     MsgBox ("No record found") 


    Else 

     MsgBox (rs.Index) 


    End If 
    end sub 

回答

0

你會最喜歡使用ActiveX數據對象來實現這一點。這將讓您從訪問數據庫中提取數據,並從Excel中更新訪問數據庫中的記錄。

這裏是微軟參考資料:https://msdn.microsoft.com/en-us/library/ms677497(v=vs.85).aspx

和一些示例代碼:

Dim cmd As New adodb.Command 
Dim conn As New adodb.Connection 
Dim rs As New adodb.Recordset 
Dim strConn As String 

strConn = "Provider = Microsoft.ACE.OLEDB.12.0;" _ 
      & "Data Source=C:\AccessDatabse.accdb" 
conn.Open strConn 

strSQL = "SELECT * FROM Table Where FristName =" & strName & ... ' or You could put your InnerJoin SQL here 

rs.Open strSQL, conn, adOpenDynamic, adLockOptimistic 

If rs.EOF then 'If the returned RecordSet is empty 

'...there is no match in database 

Else 

'the rs object will hold the ID you are looking for 

End If 

您可以添加一個新的記錄到Access數據庫:

myFieldList = Array("ID", "FirstName", "LastName") 
myValues = Array(IDValue, FirstNameValue, LastNameValue) 
rs.AddNew myFieldList, myValues 
+0

你好,請參見更新原帖 – bdpolinsky

+0

嗨伊恩,感謝您的評論。有一件事我不明白;你正在設置一個ADODB連接/記錄集,但連接字符串是OLEDB。說明? – bdpolinsky