CODEWITHSUNDEEP
excelvbams-access
BimoS
BimoS

Reputation: 131

Execute Append Query

I'm trying to insert data from VBA excel to Ms Access Database. The data was inserted successfully, the problems are

  1. it inserted multiple times. In this case, I only want to insert 3 rows, in the database has 7 rows (1 row for the first record, 2 rows for the second record, and 3 rows for the third record).

  2. this query won't work if there is no record in database, so I need to add 1 dummy record make this insert query works.

    db_path = ThisWorkbook.Path & "\PWC_Distribution_DB.accdb"
db_pass = "123abc"
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & 
db_path & ";Jet OLEDB:Database Password=" & db_pass & ";"
cn.Open
Set cm = New ADODB.Command
cm.ActiveConnection = cn
cm.CommandText = "ins_temp_table"
cm.CommandType = adCmdStoredProc
cm.Parameters.Append cm.CreateParameter("web_tracking", adVarChar, adParamInput, 100, 0)
cm.Parameters.Append cm.CreateParameter("incoming_date", adVarChar, adParamInput, 20, 0)
cm.Parameters.Append cm.CreateParameter("leads_id", adVarChar, adParamInput, 10, 0)
cm.Parameters.Append cm.CreateParameter("incoming_time", adVarChar, adParamInput, 10, 0)
cm.Parameters.Append cm.CreateParameter("leads_name", adVarChar, adParamInput, 100, 0)
cm.Parameters.Append cm.CreateParameter("phone_number", adVarChar, adParamInput, 50, 0)
cm.Parameters.Append cm.CreateParameter("email", adVarChar, adParamInput, 100, 0)
cm.Parameters.Append cm.CreateParameter("city", adVarChar, adParamInput, 100, 0)
cm.Parameters.Append cm.CreateParameter("platform", adVarChar, adParamInput, 50, 0)
cm.Parameters.Append cm.CreateParameter("app_date", adVarChar, adParamInput, 10, 0)
cm.Parameters.Append cm.CreateParameter("app_time", adVarChar, adParamInput, 10, 0)
cm.Parameters.Append cm.CreateParameter("meeting_point", adVarChar, adParamInput, 255, 0)
cm.Parameters.Append cm.CreateParameter("agent_name", adVarChar, adParamInput, 50, 0)
cm.Parameters.Append cm.CreateParameter("agent_code", adVarChar, adParamInput, 10, 0)
cm.Parameters.Append cm.CreateParameter("notes", adVarChar, adParamInput, 10, 0)

Do While wsWork.Cells(i, 1) <> ""
   'cm.Parameters.Refresh
    cm.Parameters("web_tracking").Value = wsWork.Cells(i, 4)
    cm.Parameters("incoming_date").Value = wsWork.Cells(i, 6)
    cm.Parameters("leads_id").Value = wsWork.Cells(i, 3)
    cm.Parameters("incoming_time").Value = "10:00"
    cm.Parameters("leads_name").Value = wsWork.Cells(i, 10)
    cm.Parameters("phone_number").Value = wsWork.Cells(i, 11)
    cm.Parameters("email").Value = wsWork.Cells(i, 12)
    cm.Parameters("city").Value = wsWork.Cells(i, 13)
    cm.Parameters("platform").Value = wsWork.Cells(i, 15)
    cm.Parameters("app_date").Value = wsWork.Cells(i, 31)
    cm.Parameters("app_time").Value = "11:00"
    cm.Parameters("meeting_point").Value = wsWork.Cells(i, 33)
    cm.Parameters("agent_name").Value = wsWork.Cells(i, 34)
    cm.Parameters("agent_code").Value = "x123"
    cm.Parameters("notes").Value = "x123"
    Set rs = cm.Execute()
    i = i + 1
Loop
cn.Close

enter image description here

Upvotes: 0

Views: 216

Answers (1)

Parfait
Parfait

Reputation: 107567

Consider an insert-select append query that directly references Excel spreadsheet which is allowable in MS Access SQL. Excel headers are recognized if specified in properties. No loop or dummy rows required.

In below, adjust file and worksheet names in FROM clause and columns or constants in INSERT and SELECT. Then, run inside an MS Access query window which can be saved and run later.

INSERT INTO myTable (web_tracking, incoming_date, leads_id, incoming_time, leads_name,
                     phone_number, email, city, platform, app_date, ap_time, 
                     meeting_point, agent_name, agent_code, notes)
SELECT web_tracking, incoming_date, leads_id, '10:00' AS incoming_time, leads_name,
       phone_number, email, city, platform, app_date, '11:00' AS app_time, 
       meeting_point, agent_name, 'x123' AS agent_code, 'x123' AS notes
FROM [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Excel\File.xlsx].[SheetName$]

To run a saved query with ADO:

...
cn.Open 
cn.Execute "mySavedQuery"
cn.Close

Upvotes: 2

Related Questions