Excel VBA SQL Import

Question

Hi All,

I have the following code which imports data from a spreadsheet to SQL directly from Excel VBA.

The code works great.

However I am wondering if somebody can help me modify the code to:

1) Check if data from column A already exists in the SQL Table 2) If exists, then only update rather than import as a new role 3) if does not exist then import as a new role.

Thanks again for your help

Sub SQLIM()

      ' Send data to SQL Server
 ' This code loads data from an Excel  Worksheet to an SQL Server Table
 ' Data should start in column A and should be in the same order as the server table
 ' Autonumber fields should NOT be included'
 ' FOR THIS CODE TO WORK
 ' In  VBE you need to go Tools  References and check Microsoft Active X Data  Objects 2.x library


Dim Cn As ADODB.Connection
Dim ServerName As String
Dim DatabaseName As String
Dim TableName As String
Dim UserID As String
Dim Password As String
Dim rs As ADODB.Recordset
Dim RowCounter As Long
Dim ColCounter As Integer
Dim NoOfFields As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim shtSheetToWork As Worksheet
Set shtSheetToWork = ActiveWorkbook.Worksheets("Sheet1")
Set rs = New ADODB.Recordset


ServerName = "WIN764X\sqlexpress" ' Enter your server name here
DatabaseName = "two28it" ' Enter your  database name here
TableName = "COS" ' Enter your Table name here
UserID = "" ' Enter your user ID here
 ' (Leave ID and Password blank if using windows Authentification")
Password = "" ' Enter your password here
NoOfFields = 7 ' Enter number of fields to update (eg. columns in your worksheet)
StartRow = 2 ' Enter row in sheet to start reading  records
EndRow = shtSheetToWork.Cells(Rows.Count, 1).End(xlUp).Row ' Enter row of last record in sheet

 '  CHANGES

' Dim shtSheetToWork As Worksheet ' Set shtSheetToWork = ActiveWorkbook.Worksheets("Sheet1") '**

Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & ServerName & ";Database=" & DatabaseName & _
";Uid=" & UserID & ";Pwd=" & Password & ";"

rs.Open TableName, Cn, adOpenKeyset, adLockOptimistic

For RowCounter = StartRow To EndRow
    rs.AddNew
    For ColCounter = 1 To NoOfFields
        rs(ColCounter - 1) = shtSheetToWork.Cells(RowCounter, ColCounter)
    Next ColCounter
Next RowCounter
rs.UpdateBatch

 ' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing

End Sub

Answer 1

This is the wrong way to do this task. Do this from the SQL server instead. Look up the merge command if you are using SQL Server 2008.

Also consider using SSIS to do this task, it is a better choice than doing it from VBA. OR look up the OPenrowset command in t-SQL and do it that way.