CODEWITHSUNDEEP
mysqlarraysms-accessvba
RAKH
RAKH

Reputation: 45

In vba fill Array from QUery then insert the data into table

So I want to insert the result of a query into an array then I will loop over the array to insert new rows to a new table. Here is the code I've done:

Public cnn As New ADODB.Connection
Public db As DAO.Database

Public Sub SUD_Main()
    Set db = Access.Application.CurrentDb
    Set cnn = CurrentProject.Connection

     Refreash    
End Sub

Private Sub Refreash()
Dim DataArr() As String
    Dim p As Variant
    Dim sql As String
    Dim XDATA As New ADODB.Recordset
    Dim RDS As DAO.Recordset
    Set RDS = db.OpenRecordset("tbl_dets")

    sql = "SELECT DISTINCT NAME FROM Types_tbl WHERE NAME LIKE 'Rob%'"
    XDATA.Open sql, cnn, adOpenStatic

    '''
    '' HERE I WANT TO FILL DataArr FROM XDATA
    '''
    DataArr = XDATA.GetRows

    XDATA.Close
    For Each p In DataArr
        sql = "SELECT DISTINCT TID FROM Types_tbl WHERE NAME ='" & p & "'"
        XDATA .Open sql, cnn, adOpenStatic

       Do Until XDATA.EOF
       DoEvents 
           '''Inserting new records to tbl_dets
           RDS.AddNew
           RDS!Name = p
           RDS!TID= XDATA!TID
           RDS.Update
           XDATA.MoveNext
       Loop
       XDATA.Close
    Next
End Sub

So what I am missing? I thing that the error is in the Array but didn't know how to fix it.

Upvotes: 1

Views: 1883

Answers (1)

Erik A
Erik A

Reputation: 32672

Your code is mostly valid, but you are making some mistakes. GetRows returns a multi-dimensional array with rownumbers and fields. As such, you can't fit it into a string. You need to use an array of type variant.

Private Sub Refreash()
    Dim DataArr() As Variant
    Dim p As Variant
    Dim sql As String
    Dim XDATA As New ADODB.Recordset
    Dim RDS As DAO.Recordset
    Set RDS = db.OpenRecordset("tbl_dets")

    sql = "SELECT DISTINCT NAME FROM Types_tbl WHERE NAME LIKE 'Rob%'"
    XDATA.Open sql, cnn, adOpenStatic

    '''
    '' HERE I WANT TO FILL DataArr FROM XDATA
    '''
    'Make sure XData fetches all records
    XData.MoveLast
    XData.MoveFirst
    DataArr = XDATA.GetRows

    XDATA.Close
    For Each p In PATTs
        sql = "SELECT DISTINCT TID FROM Types_tbl WHERE NAME ='" & p & "'"
        XDATA .Open sql, cnn, adOpenStatic

       Do Until XDATA.EOF
       DoEvents 
           '''Inserting new records to tbl_dets
           RDS.AddNew
           RDS!Name = p
           RDS!TID= XDATA!TID
           RDS.Update
           XDATA.MoveNext
       Loop
       XDATA.Close
    Next
End Sub

Note that there are some things I still don't understand about this sub, possibly because it is not finished, such as it not using DataArr anywhere after setting it and the use of both ADO and DAO (I'd prefer to only do DAO in this case).

Upvotes: 1

Related Questions