How to update sql server data from excel data using VBA code

Question

4.00/5 (1 vote)

See more:

Hi,

I have an Excel file which have a data and a table in sql server 2000.
I am doing it by excel VBA code. The code which I written in Excel is on event of
Workbook_SheetChange. The code foe that Even is written below

VB

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 ' Don't allow changes in the column names or outside of the table borders
'   If Target.Row < 2 Or Sh.Cells(1, Target.Row).Text = "" Or Sh.Cells(1, Target.Column) = "" Or (Target.Row > nRecordCount + 1) Then
'       Target.Value = oldValue
'       oldValue = Application.ActiveCell.Value
'       MsgBox "You can only edit items inside the table"
'       Exit Sub
'   End If
 
 ' Is this change is in a primary key column - if so, we can't edit it
'   If (IsInPrimaryKey(Sh.Cells(1, Target.Column).Text)) Then
'     Target.Value = oldValue
'     oldValue = Application.ActiveCell.Value
'     MsgBox "This column is a part of the primary key, so it cannot be changed"
'     Exit Sub
'   End If
   
    ' Build the primary key from the data in this row
    Dim con As Object
    Set con = CreateObject("ADODB.Connection")
    
    con.ConnectionString = "DRIVER=SQL Server;SERVER=PANKAJ;UID=ADMIN;WSID=USER;DATABASE=hotel;Trusted_Connection=Yes"
 
   Dim Names As Range
   Set Names = Sh.Range("A1")
 nColumn = 0
 sWhere = ""
   While (Names.Offset(0, nColumn).Text <> "")
       'If (IsInPrimaryKey(Names.Offset(0, nColumn).Text)) Then
       If Names.Offset(0, nColumn).Text = "itm_id" Then
           If (sWhere <> "") Then
               'sWhere = sWhere & " AND "
              sWhere = sWhere
                
           End If
           sWhere = sWhere & Sh.Cells(1, nColumn + 1).Text & " = " & Sh.Cells(Target.Row, nColumn + 1) & ""
         End If
       nColumn = nColumn + 1
   Wend
   

'And perform the change:

 ' Update the server!
  sSQL = "UPDATE " & Sh.Name & " SET " & Sh.Cells(1, Target.Column).Text & " = '" & Target.Text & "' WHERE " & sWhere
 con.Open
 con.Execute sSQL
  oldValue = Application.ActiveCell.Value
 
End Sub

It is working fine on this event but when I want use it with button on click event it do not working.
I can not get the argument for that. I just want to update that that excel data into sql server on button click event.

Thanks in advance

Posted 13-Oct-12 1:29am

singh7pankaj

Add a Solution

Comments

Jim Jos 14-Oct-12 20:09pm

If I understand correctly you want to refer the workseet object in the button click event?

3 solutions

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Maciej Los · Answer 1 · 2012-10-14T11:42:00

Could it be a custom menu?

Steps to do:
1) Add new module (Menu Insert->Module)
2) Copy and paste code below

VB

Option Explicit

Public Const sMyMenu As String = "UpdSQL"

Sub AddMyMenu()
Dim cb As CommandBar
Dim cpopup As CommandBarControl, ctrbtn As CommandBarControl

DelMyMenu sMyMenu

On Error GoTo Err_AddMyMenu

Set cb = Application.CommandBars.Add(sMyMenu, msoBarTop)
Set cpopup = cb.Controls.Add(msoControlPopup)
With cpopup
    .Caption = "My database"
    .TooltipText = .Caption
End With

Set ctrbtn = cpopup.Controls.Add(msoControlButton)
With ctrbtn
    .Caption = "Update"
    .TooltipText = .Caption
    .Style = msoButtonIconAndCaption
    .FaceId = 473
    .OnAction = "UpdateDatabase"
End With

cb.Visible = True

Exit_AddMyMenu:
    On Error Resume Next
    Set ctrbtn = Nothing
    Set cpopup = Nothing
    Set cb = Nothing
    Exit Sub
    
Err_AddMyMenu:
    Resume Exit_AddMyMenu

End Sub


Sub DelMyMenu(sWhich As String)
On Error Resume Next
    Application.CommandBars(sWhich).Delete
End Sub


Sub UpdateDatabase()
'move the body of Workbook_SheetChange() procedure here
MsgBox "Hello!", vbInformation, "Information..."
End Sub

3) In the project browser (object browser) go to the ThisWorkbook object, double click on it to activate it's module:

VB

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    DelMyMenu sMyMenu
End Sub

Private Sub Workbook_Open()
    AddMyMenu
End Sub

That's all

singh7pankaj · Answer 2 · 2012-10-15T00:39:00

This code working perfectly which is written below:

VB

Private Sub CommandButton1_Click()

'************************ Variable Declaration Part Start from here *****************************
Dim con As Object ' variable for connection string
Dim cellsdata As Range ' this variable is used to store all data
Dim cl As Range ' this variable is used to get single data from all range
Dim str As String ' this variable is used to store query of update
Dim ins As String
Dim insqry As String ' this variable is used to store query of insert
Dim flag As Integer ' this flag is used to check that the query is insert or update
Dim cnt_for_space As Integer ' this variable is used to check that all the cells of single row is blank or not
Dim qryary(200) As String ' create 200 size of array to store 200 different query into this array
Dim i As Integer
Dim qryindex As Integer ' it is index value which is used for array
Dim cnt As Integer
'************************ Variable Declaration Part End Here *****************************



'************************ variable initialization Part Start From Here *****************************
Set cellsdata = Worksheets(1).Range("A2:N100") ' this is the range from where data start and up to where it ends
Set con = CreateObject("ADODB.Connection") ' create instance of connection
con.ConnectionString = "DRIVER=SQL Server;SERVER=PANKAJ;UID=ADMIN;WSID=USER;DATABASE=hotel;Trusted_Connection=Yes" ' add connection string to variable with all the arguments
i = 1
qryindex = 0
cnt_for_space = 0
flag = 0
str = "UPDATE call_dtl set" ' predifined value of variable to concatenate for further at the time of updation
insqry = "insert into call_dtl(call_no,cust_name,ven,cont_name,cont_no,rep_no,prob_report,cse,call_rec,call_arr,call_comp,status,remks)values('" ' predifined value of variable to concatenate for further at the time of insert
'************************ variable initialization Part End Here *****************************



'************************ All The Logic Start From Here *****************************
For Each cl In cellsdata  ' this is a loop from where we can all data
'MsgBox cl.Value
If (i = 1) Then ' this condition is for the first excel column named "call_no"
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & " call_no='" & cl.Value & "'" ' contactenate data to make updation query
insqry = insqry & cl.Value & "','" ' contactenate data to make insertion query
End If

If (i = 2) Then ' this condition is for the first excel column named "cust_name"
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",cust_name='" & cl.Value & "'" ' contactenate data to make updation query
insqry = insqry & cl.Value & "','" ' contactenate data to make insertion query
End If

If (i = 3) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",ven='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 4) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",cont_name='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 5) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",cont_no='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 6) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",rep_no='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 7) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",prob_report='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 8) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",cse='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 9) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",call_rec='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 10) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",call_arr='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 11) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",call_comp='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 12) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",status='" & cl.Value & "'"
insqry = insqry & cl.Value & "','"
End If

If (i = 13) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
End If
str = str & ",remks='" & cl.Value & "'"
insqry = insqry & cl.Value & "')" 'concatenate the insertion query and the insertion query complete because we do not want to add itm_id column into database
End If

If (i = 14) Then
If (cl.Value = "") Then
cnt_for_space = cnt_for_space + 1
flag = 1
'MsgBox "Value not available" & "       =" & cl.Value
End If
str = str & " where itm_id=" & cl.Value & "" 'updation query ends here with condition
End If


If i = 14 Then ' this condition is used to re initialize the value and store the query into array
i = 0

    If cnt_for_space = 14 Then ' this condition is used to check that all cells of single row is blank. if all the cell of row is blank the exit from the loop because we do not want to insert or update whole row which is blank
    Exit For
    End If

If (flag = 0) Then 'if flag=0 then it is update query and if it is 1 then it is insert query
qryary(qryindex) = str
Else
qryary(qryindex) = insqry
End If

cnt_for_space = 0 'reinitialize the value for the next row
flag = 0 'reinitialize the value for the next row
qryindex = qryindex + 1 ' increase the index value of array to store another query in next position of array
str = "UPDATE call_dtl set" 'reinitialize the value for the next row
insqry = "insert into call_dtl(call_no,cust_name,ven,cont_name,cont_no,rep_no,prob_report,cse,call_rec,call_arr,call_comp,status,remks)values('" 'reinitialize the value for the next row
End If

i = i + 1 'increase the the value to get the next value of cell

Next cl


For lp = 0 To qryindex - 1 ' this loop is used to get query from the array which is stored in previous loop
con.Open 'open the connection
con.Execute qryary(lp) ' execute the query one by one according to index value
oldValue = Application.ActiveCell.Value
con.Close
Next lp
MsgBox "Data Updated Successfully"
ThisWorkbook.RefreshAll ' refresh the data of workbook after updating and inserting cells data into database
End Sub


'************************ All The Logic End Here *****************************

'################################# Thank You ###############################

Member 10590182 · Answer 3 · 2015-08-06T02:18:00

Solution 4

[Microsoft][ODBC SQL Server Driver][SQL Server]Incorrect syntax near '*'

Posted 6-Aug-15 2:18am

Member 10590182

Updated 6-Aug-15 2:31am

v2

How to update sql server data from excel data using VBA code

3 solutions

Solution 1

Solution 2

Solution 4

Add your solution here

Preview 0