How to update Sql server table from excel data using vba code?

Question

I have a table and I'm trying to update the sql table Month columns from spreadsheet using vba but it doesn't seem to work. I edited the vba code from yesterday and I get the error "Operation is not allowed when the object is closed." I am new to vba programming and so any help is appreciated.

CREATE TABLE [dbo].[Actual_FTE](
[EmpID] [nvarchar](15) NOT NULL,
[EName] [nvarchar](50) NULL,
[CCNum] [nvarchar](10) NOT NULL,
[CCName] [nvarchar](50) NULL,
[ProgramNum] [nvarchar](10) NULL,
[ProgramName] [nvarchar](50) NULL,
[ResTypeNum] [nvarchar](10) NULL,
[ResName] [nvarchar](50) NULL,
[January] [nvarchar](50) NULL,
[February] [nvarchar](50) NULL,
[March] [nvarchar](50) NULL,
[April] [nvarchar](50) NULL,
[May] [nvarchar](50) NULL,
[June] [nvarchar](50) NULL,
[July] [nvarchar](50) NULL,
[August] [nvarchar](50) NULL,
[September] [nvarchar](50) NULL,
[October] [nvarchar](50) NULL,
[November] [nvarchar](50) NULL,
[December] [nvarchar](50) NULL,
[Total_Year] [nvarchar](50) NULL,
[Year] [nvarchar](6) NULL,
[Scenario] [nvarchar](10) NULL

)

The vba code is:

Public Sub UpdateToDatabase()

 Dim sBackupUpdQry As String
Dim sBackupInsQry As String

Dim sUpdQry As String
Dim sInsQry As String
Dim sExistQry As String
Dim sWhere As String

Dim iRows As Integer
Dim iCols As Integer

On Error GoTo ErrHandler




'Find last row and last column
Dim lLastRow As Long
Dim lLastCol As Integer
lLastRow = Cells.Find("*", Range("A4"), xlFormulas, , xlByRows, xlPrevious).Row ' Find the last row with data
lLastCol = Cells.Find("*", Range("A4"), xlFormulas, , xlByColumns, xlPrevious).Column ' Find the last column with data


Dim qryUpdateArray(2000) As String
Dim qryInsertArray(2000) As String
Dim qryExistArray(2000) As String
Dim iRecCount As Integer
Dim sCellVal As String
Dim sColName As String


With Sheets("Main")

    sBackupUpdQry = "UPDATE Actual_FTE SET " ' predefined value of variable to concatenate for further at the time of updation
    sBackupInsQry = "INSERT INTO Actual_FTE ("
    sWhere = ""

    'starting from row3, which is the header/column-name row
    'prepare the insert/update queries
    iRows = 3
    iRecCount = 1
    For iCols = 1 To lLastCol
        sColName = Cells(iRows, iCols)


        If (sColName = "") Then
            MsgBox ("Empty Column Name")
            Exit Sub
        End If

        If (iCols = 1) Then
            sBackupInsQry = sBackupInsQry + sColName
        Else
            sBackupInsQry = sBackupInsQry + ("," + sColName)
        End If
    Next iCols
    sBackupInsQry = sBackupInsQry + ")VALUES("


    'loop through each column to add the insert/update data
    For iRecCount = 1 To lLastRow - 3
        iRows = iRows + 1
        sUpdQry = sBackupUpdQry
        sInsQry = sBackupInsQry

        For iCols = 1 To lLastCol
            sColName = CStr(Cells(3, iCols))



            sCellVal = CStr(Cells(iRows, iCols))
            If (InStr(1, sCellVal, "'")) Then
                sCellVal = Replace(sCellVal, "'", "''")
            End If

            If (iCols = 1) Then
                sUpdQry = sUpdQry + (sColName + "='" + sCellVal + "'")
                sInsQry = sInsQry + ("'" + sCellVal + "'")

               Else
                 sUpdQry = sUpdQry + ("," + sColName + "='" + sCellVal + "'")
                 sInsQry = sInsQry + (",'" + sCellVal + "'")

            End If


        Next iCols

        sInsQry = sInsQry + ")"
        sUpdQry = sUpdQry + sWhere

        'save all queries into string array, maximum 1000
        qryUpdateArray(iRecCount) = sUpdQry
        qryInsertArray(iRecCount) = sInsQry
        qryExistArray(iRecCount) = sExistQry

    Next iRecCount


End With

Call DBConnection.OpenDBConnection

Dim rsMY_Resources As ADODB.Recordset
Set rsMY_Resources = New ADODB.Recordset


Dim cntUpd As Integer
Dim cntIns As Integer
cntUpd = 0
cntIns = 0

For iRecCount = 1 To lLastRow - 3
    'check if the asset number exists.
    'MsgBox qryExistArray(iRecCount)
    Set rsMY_Resources = oConn.Execute(qryExistArray(iRecCount))

    'if exists, update the record; if not, insert a new record
    If (rsMY_Resources.Fields(0).Value = 0) Then
        'MsgBox "Insert"
        'MsgBox qryInsertArray(iRecCount)
        oConn.Execute qryInsertArray(iRecCount)
        cntIns = cntIns + 1
    Else
        'MsgBox "Update"
        'MsgBox qryUpdateArray(iRecCount)
        oConn.Execute qryUpdateArray(iRecCount)
        cntUpd = cntUpd + 1
    End If
Next iRecCount

'Clean up
rsMY_Resources.Close:
Set rsMY_Resources = Nothing

Call DBConnection.CloseDBConnection
MsgBox ("Actual_FTE table has been updated: " + CStr(cntUpd) + " records have been updated; " + CStr(cntIns) + " new records have been inserted")


Exit Sub

ErrHandler: MsgBox (Error)

End Sub

Thanks, H

Please add an example actual of the update SQL that is being executed. Run that and show what the actual SQL error is. — Keith John Hutchison
– Keith John Hutchison, Commented Jun 19, 2017 at 22:39
The query runs fine without errors but instead of updating the rows, new rows are being inserted. — Hema
– Hema, Commented Jun 19, 2017 at 22:56
if you want to update the rows, why do you have insert statement in the code? — Ibo
– Ibo, Commented Jun 19, 2017 at 23:05

Tim Williams · Accepted Answer · 2017-06-19 23:19:07Z

2

You're padding the last 4 variables in your where clause with a trailing space, so likely that's why only the "insert" query runs (because your where never gets any hits)

  ' construct the where clause
    sWhere = " Where EmpID = '" + strEmpID + "' 
   and CCNum = '" + strCCNum + "' 
   and ProgramNum = '" + strProgramNum + "' 
   and ResTypeNum = '"  + strResTypeNum + " ' 
   and Total_Year = '" + strTotal_year + " ' 
   and Year = '" + strYear + " ' 
   and Scenario = '" + strScenario + " '"

answered Jun 19, 2017 at 23:19

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Hema Over a year ago

It's still not working even after removing those spaces! I have only 5 rows in my table which I'm trying to update. But each time, it says "0 records updated and 5 records inserted"

Tim Williams Over a year ago

Debug.Print one of your qryExistArray values for which there should be a matching record in the table: do you get a non-zero count when you run that SQL ?

A.S.H Over a year ago

@Hema why don't you Debug.Print sUpdQry before executing it? may be if you post it debugging will be mucheasier.

Keith John Hutchison · Accepted Answer · 2017-06-19 23:32:18Z

0

Your branching code is wrong. Try having one array.

I suggest changing

    'save all queries into string array, maximum 1000
    qryUpdateArray(iRecCount) = sUpdQry
    qryInsertArray(iRecCount) = sInsQry
    qryExistArray(iRecCount) = sExistQry

to

    'save all queries into string array, maximum 1000
    if sExistQry = '1' then
        queriesArray(iRecCount) = sUpdQry
    else
        queriesArray(iRecCount) = sInsQry
    end if

and then run the sql from queriesArray later on.

edited Jun 19, 2017 at 23:32

answered Jun 19, 2017 at 23:30

Keith John Hutchison

5,34711 gold badges49 silver badges66 bronze badges

4 Comments

Tim Williams Over a year ago

Code is overly complex but I'm not sure it's wrong.

Keith John Hutchison Over a year ago

The reason the inserts are happening is because the branch logic later is wrong. The OP may as well branch where they are finding out if the record exists or not.

Tim Williams Over a year ago

I'm putting my bet on the "exists" query being the problem (in which case it wouldn't matter when that was run), so let's see!

Keith John Hutchison Over a year ago

That's my bet as well ... the reason the updates don't run is because the branch logic is wrong.

Collectives™ on Stack Overflow

How to update Sql server table from excel data using vba code?

2 Answers 2

3 Comments

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related