VBA to Append With Primary Key (1 Viewer)

graviz

Registered User.
Local time
Today, 13:31
Joined
Aug 4, 2009
Messages
167
I currently have this code to spit out some data into a table, however I would like to tweak it to be more of an append query. I know I need to use "INSERT INTO" somehow based on searching, but I also want to ensure the table doesn't get duplicate records in it from the previous code. Manually adding a primary key isn't an option as the table may be deleted. Any suggestions on how I can tweak the code below is appreciated.

Code:
Public Function Output_RFC_Tables_Test()
Dim Conn As ADODB.Connection
Dim RS As New ADODB.Recordset
Dim MySQL As String
Dim ArrayRS As ADODB.Recordset
Set ArrayRS = New ADODB.Recordset
Set Conn = CurrentProject.Connection
RS.ActiveConnection = Conn
ArrayRS.ActiveConnection = CurrentProject.Connection
ArrayRS.Open ("REF_ARRAY")
While ArrayRS.EOF = False
    If ArrayRS.Fields.Item(2).Value <> "12/25/2025" Then
        MySQL = "SELECT RFC_STAGING_3.RFC, RFC_STAGING_3.RFC_TITLE, RFC_STAGING_3.RFC_STATE, RFC_STAGING_3.RFC_OBJECTIVE, RFC_STAGING_3.PM, RFC_STAGING_3.BUS_PORTFOLIO, RFC_STAGING_3.BRM, RFC_STAGING_3.Impacted_Teams, RFC_STAGING_3.Notes" & " " & _
        "INTO " & ArrayRS.Fields.Item(0).Value & " " & _
        "FROM RFC_STAGING_3" & " " & _
        "WHERE (((RFC_STAGING_3.DATE_TARGET_AFB) = #" & ArrayRS.Fields.Item(2).Value & "#) And ((RFC_STAGING_3.CCA_Project) = 1))" & " " & _
        "GROUP BY RFC_STAGING_3.RFC, RFC_STAGING_3.RFC_TITLE, RFC_STAGING_3.RFC_STATE, RFC_STAGING_3.RFC_OBJECTIVE, RFC_STAGING_3.PM, RFC_STAGING_3.BUS_PORTFOLIO, RFC_STAGING_3.BRM, RFC_STAGING_3.Impacted_Teams, RFC_STAGING_3.Notes" & " " & _
        "ORDER BY RFC_STAGING_3.PM;"
        
        RS.Open MySQL
        
        ArrayRS.MoveNext
    
    Else
    
        ArrayRS.MoveNext
    
    End If
Wend
Set Conn = Nothing
End Function
 

TJPoorman

Registered User.
Local time
Today, 13:31
Joined
Jul 23, 2013
Messages
402
Look at this link for the proper syntax for INSERT INTO SELECT.
Then to execute the SQL from your VBA would be something like this:
Code:
Public Function InsertIt()
Dim strSQL As String
Dim db as DAO.Database

strSQL = "INSERT INTO MyTable SELECT * FROM MyOtherTable"
Set db = CurrentDb

db.Execute(strSQL)

Set db = Nothing
End Function
 

graviz

Registered User.
Local time
Today, 13:31
Joined
Aug 4, 2009
Messages
167
Look at this link for the proper syntax for INSERT INTO SELECT.
Then to execute the SQL from your VBA would be something like this:
Code:
Public Function InsertIt()
Dim strSQL As String
Dim db as DAO.Database
 
strSQL = "INSERT INTO MyTable SELECT * FROM MyOtherTable"
Set db = CurrentDb
 
db.Execute(strSQL)
 
Set db = Nothing
End Function

So that's what I was trying but I didn't want to create duplicate records. Here's my code that works but it's creating dups:

Code:
Public Function Output_RFC_Tables_Test()
Dim Conn As ADODB.Connection
Dim RS As New ADODB.Recordset
Dim MySQL As String
Dim ArrayRS As ADODB.Recordset
Set ArrayRS = New ADODB.Recordset
Set Conn = CurrentProject.Connection
RS.ActiveConnection = Conn
ArrayRS.ActiveConnection = CurrentProject.Connection
ArrayRS.Open ("REF_ARRAY")
While ArrayRS.EOF = False
    If ArrayRS.Fields.Item(2).Value <> "12/25/2025" Then
        MySQL = "INSERT INTO " & ArrayRS.Fields.Item(0).Value & " " & _
        "SELECT RFC_STAGING_3.RFC, RFC_STAGING_3.RFC_TITLE, RFC_STAGING_3.RFC_STATE, RFC_STAGING_3.RFC_OBJECTIVE, RFC_STAGING_3.PM, RFC_STAGING_3.BUS_PORTFOLIO, RFC_STAGING_3.BRM, RFC_STAGING_3.Impacted_Teams, RFC_STAGING_3.Notes" & " " & _
        "FROM RFC_STAGING_3" & " " & _
        "WHERE (((RFC_STAGING_3.DATE_DEPLOY_1) = #" & ArrayRS.Fields.Item(2).Value & "#) And ((RFC_STAGING_3.CCA_Project) = 1))" & " " & _
        "GROUP BY RFC_STAGING_3.RFC, RFC_STAGING_3.RFC_TITLE, RFC_STAGING_3.RFC_STATE, RFC_STAGING_3.RFC_OBJECTIVE, RFC_STAGING_3.PM, RFC_STAGING_3.BUS_PORTFOLIO, RFC_STAGING_3.BRM, RFC_STAGING_3.Impacted_Teams, RFC_STAGING_3.Notes" & " " & _
        "ORDER BY RFC_STAGING_3.PM;"
        
        RS.Open MySQL
        
        ArrayRS.MoveNext
    
    Else
    
        ArrayRS.MoveNext
    
    End If
Wend
Set Conn = Nothing
End Function

I run the first function in this thread and then run this one however I don't want duplicates added to this table. Let me know if that makes more sense.
 

TJPoorman

Registered User.
Local time
Today, 13:31
Joined
Jul 23, 2013
Messages
402
Do you not have a Primary Key field in your tables?
This sounds like a design issue.
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 20:31
Joined
Jul 9, 2003
Messages
16,283
How about if you create a unique index for the fields you don't want duplicated. That should prevent any duplicates being added.
 

graviz

Registered User.
Local time
Today, 13:31
Joined
Aug 4, 2009
Messages
167
How about if you create a unique index for the fields you don't want duplicated. That should prevent any duplicates being added.

If the table gets deleted each time how would I do that. Basically what I'm saying is I can't go into the design of the table and set one to a primary key. There is a unique field if there's a way to do it through code.
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 20:31
Joined
Jul 9, 2003
Messages
16,283
I put the following code together from some code by khawar and from a sample I saw on Allen Brownes website. Replace the table tblYourTableName with your table, then give the index a name which suits you, in other words replace NewIndexName with your own name for the index. Then, the fields you want to index, add them where it says fldYourField1, fldYourField2

Code:
Public Function fAddIndex()
'Adapted from this Thread:- http://www.access-programmers.co.uk/forums/showthread.php?t=180542
'And Allen Browne Here:- http://allenbrowne.com/func-DDL.html
Dim cmd As New ADODB.Command
Dim strSQL As String
    
    'Initialize
    cmd.ActiveConnection = CurrentProject.Connection

        strSQL = "ALTER TABLE tblYourTableName ADD CONSTRAINT NewIndexName UNIQUE (fldYourFeild1, fldYourFeild2)"

    cmd.CommandText = strSQL
    cmd.Execute

End Function 'fAddIndex
 
Last edited:

Users who are viewing this thread

Top Bottom