Inserting data from sqlserver to Excel and vice versa automatically ?

[hayath786]

The below code brings me data from sqlserver, however when im loading back I can only make changes to the first 3 rows on the spreadsheet. When I edit the 4th row I get he error "You can only edit items inside the table".

Anybody knows a solution for this?


' General variables we'll need
Public con As ADODB.Connection
Public bIgnoreChange As Boolean
Dim pk As New Collection
Dim oldValue As Variant
Dim nRecordCount As Integer


Private Sub Workbook_Deactivate()
If Not (con Is Nothing) Then
con.Close
Set con = Nothing
End If
End Sub


Function IsInPrimaryKey(name As String)
For Each pki In pk
If (pki = name) Then
IsInPrimaryKey = True
Exit Function
End If
Next pki
IsInPrimaryKey = False
End Function


Function MakeSQLText(data As Variant)
If (IsNumeric(data)) Then
MakeSQLText = data
Else
MakeSQLText = "'" & Replace(data, "'", "''") & "'"
End If
End Function


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' Let's retrieve the data from the SQL Server table with the same name as the sheet
bIgnoreChange = True
Set con = New ADODB.Connection
con.Provider = "sqloledb"
sConnectionString = "Server=SERVERNAME;Database=DBNAME;UID=sa;Pwd=password"
con.Open sConnectionString

' Clean up old Primary Key
While (pk.Count > 0)
pk.Remove 1
Wend

' Try to retrieve the primary key information
On Error GoTo NoCon
Set rs = con.Execute("SELECT COLUMN_NAME FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS AS tc INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE AS kcu ON tc.CONSTRAINT_NAME = kcu.CONSTRAINT_NAME WHERE tc.CONSTRAINT_TYPE = 'PRIMARY KEY' AND tc.TABLE_NAME = '" & Sh.name & "'")

' Fill up the primary key infomration
While (Not rs.EOF)
pk.Add CStr(rs(0))
rs.MoveNext
Wend

' Clean up the sheet's contents
Sh.UsedRange.Clear

' Now get the table's data
Set rs = con.Execute("SELECT * FROM " & Sh.name)

' Set the name of the fields
Dim TheCells As Range
Set TheCells = Sh.Range("A1")
For i = 0 To rs.Fields.Count - 1
TheCells.Offset(0, i).Value = rs.Fields(i).name
Next i

' Get value for each field
nRow = 1
While (Not rs.EOF)
For i = 0 To rs.Fields.Count - 1
TheCells.Offset(nRow, i).Value = rs(i)
Next
rs.MoveNext
nRow = nRow + 1
Wend
nRecordCount = nRow - 1

bIgnoreChange = (pk.Count = 0) And (nRecordCount > 0)


Exit Sub


NoCon:
con.Close
Set con = Nothing
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' No loops, and don't do nothing if there's no connection
If bIgnoreChange Or con Is Nothing Then
Exit Sub
End If

' Is something different?
If (Target.Value = oldValue) Then
' No change
oldValue = Application.ActiveCell.Value
Exit Sub
End If

' 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 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 (sWhere <> "") Then
sWhere = sWhere & " AND "
End If
sWhere = sWhere & Sh.Cells(1, nColumn + 1).Text & " = " & MakeSQLText(Sh.Cells(Target.Row, nColumn + 1))
End If
nColumn = nColumn + 1
Wend

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

End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If (Not bIgnoreChange) Then
' Remember the old value
oldValue = Application.ActiveCell.Value
End If
End Sub

 

[ChrisM]

That error message is caused by your own code!

' 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

Lol, we'll have to ask you why it's there!

 

[hayath786]

I was able to fix the issue, had to make a simple switch:

' Don't allow changes in the column names or outside of the table borders
If Target.Row < 2 Or Sh.Cells(Target.Row, 1).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

 

[hayath786]

Hello, now I have another issue.

the code doesn't work for multiple tabs. I am trying to work on multiple tables on the same spreadsheet pulling data from each table to a new tab?