VBA export to SQL

[powerdink]

I have a sheet called "DATA" in excel that I want to export to a SQL Server DB. First to check if the records exists, if it does, update it, otherwise add a new record if it doesn't.
What I have is below, but it seems extremely slow and inefficient. Is there a way to send this data in batches of say 10 rows at a time or something?

Call InitializeConnection                  ' calls a function that connects to the SQL Server
 
'everything has been previously Dim'd. 
 
 
  Set r = ActiveWorkbook.Sheets("DATA").Range("A1").CurrentRegion
 
  With r
      lngRows = r.Rows.Count
 
      For i = 1 To lngRows
 
          'Set the material numbers as the PrimaryKey
          PrimaryKey = "" & ActiveWorkbook.Sheets("DATA").Range("A" & i).Value & ""
 
          Set rsRecordSet = GetRecordsfromDB("SELECT count(*) AS record_count FROM tbl_TIC_material_master WHERE material = " & PrimaryKey)
 
          If rsRecordSet("record_count") = 0 Then
              strSQL = "INSERT INTO tbl_TABLENAME (Field 1, Field 2, Field 3, Field 4, Field 5, Field 6, Field 7,  Maint_User, Maint_Date)" _
              & "VALUES ('" & PrimaryKey & "', '" & r.Offset(i, 2).Value & "', '" & r.Offset(i, 3).Value & "', '" & r.Offset(i, 4).Value & "', '" & r.Offset(i, 5).Value & "', '" & r.Offset(i, 6).Value & "', '" & r.Offset(i, 7).Value & "',  '" & Environ("USERNAME") & "', CAST('" & Now() & "' AS datetime))"
 
              lngRecordsAffected = ExecuteSQL(strSQL)
          Else
              strSQL = "UPDATE tbl_TBLNAME SET Field 2 = 'r.offset(i,2).value', Field  3= 'r.offset(i,3).value', Field 4 = 'r.offset(i,4).value', Field  5= 'r.offset(i,5).value', Field  5 = 'r.Offset(i,5).Value', Field 6 = 'r.Offset(i,6).Value', Field 7 = 'r.Offset(i,7).Value',"  _
              & "Maint_User = '" & Environ("USERNAME") & "', Maint_Date = CAST('" & Now() & "'AS datetime) WHERE Field 1 = " & PrimaryKey & ""
 
              lngRecordsAffected = ExecuteSQL(strSQL)
          End If
 
          If lngRecordsAffected <> 1 Then
              strErrorMessage = "Error during Database update"
              strRoutine = "Export Data"
              lngErrorNumber = Err.Number
              strErrorDescription = Err.Description
          GoTo ErrorHandler
          End If
 
      Next i
 
      'Clear range variables
      Set rsRecordSet = Nothing
      Set r = Nothing
 
  End With
 
  Call EndDBConnection             'Closes DB connection
 
  End
 
 
ErrorHandler:
  'Send arguments to a function that displays error information, etc.
  Call DisplayError(strErrorMessage, strRoutine, lngErrorNumber, strErrorDescription)
 
  Call EndDBConnection               'Closes DB connection

 

[Norie]

It is possible to export a load of data from Excel to SQL server but I'm not sure about how that would fit into your update/new record part.

If you had the data in the database you could probably do that with a couple of queries, provided there was a link between the existing and new data.

I've got code that insert records into a table in an SQL server with data from Excel based on criteria.

But the criteria was pretty simple and was hard-coded.

I think it was to only insert records beyond a certain date or something, so it was just a WHERE clause.

 

[powerdink]

I have to export using Excel as the users don't all have access to the SQL database. The connection, username and password are set in a seperate mod and all VB is password protected.

The current code I am running now takes like 40 minutes to execute line by line. I was told you can group data into batches and send a few lines at a time which will speed things up greatly when we are touching 10,000+ records.

 

[mole999]

I have an interest in a working solution, care to share the vba connection etc

the company that manages the database for work want paying every upload, and we do have access to the server to do the work.

I'd like a working solution that i could use every three months to bulk correct missed enteries

 

[Norie]

powerdink

I'm not sure I understand your response.

I was trying to say there is a way to do bulk import's to SQL from Excel.

But I don't know if it would be entirely suitable for exactly what you are trying to do.

Here's a very simple example.

Sub ADOXLtoSQLSRV()
Dim cn As ADODB.Connection
Dim strConn As String
Dim strSQL As String
Dim strXLSource As String
Dim lngRecsAff As Long
 
    strConn = strConn & "Provider=SQLOLEDB;Data Source=<SQL Database>;"
    strConn = strConn & "Initial Catolog=<SQL Table>;Trusted_Connection=YES"
    Set cn = New ADODB.Connection
    cn.Open strConn
    strXLSource = "C:\Users\Norie\Documents\ExcelStuff\MockData\AccountNos.xls;Extended Properties=Excel 12.0"
    
    
    '
    'Import by using OPENDATASOURCE.
    '
    'INSERT INTO <SQLSRV Table>
    '(SQL Fields)
    '
    'SELECT <Excel headers/fields>
    '
    'FROM OPENDATASOURCE('Microsoft.ACE.OLEDB.12.0', 'Data Source=<Excel Workbook;Extended Properties=Excel 12.0')...[<Excel worksheet/range>$]

    strSQL = " INSERT INTO StaffLevel.dbo.XLImport178 "
    strSQL = strSQL & " ([Account]) "
    strSQL = strSQL & " SELECT [Account] "
    strSQL = strSQL & " FROM "
    strSQL = strSQL & " OPENDATASOURCE('Microsoft.ACE.OLEDB.12.0', 'Data Source=" & strXLSource & "')...[tblAccounts$] "
 
    Debug.Print strSQL

    cn.Execute strSQL, lngRecsAff, adExecuteNoRecords

    Debug.Print "Records affected: " & lngRecsAff

It uses a simple SELECT with no criteria for the data from Excel but you can use criteria.

I assume you can use all the other functionality available with queries, eg joins etc. but I've never investigated that fully.

Oh, and this is VBA that runs from Excel.

 

[powerdink]

I went back to the drawing board and came up with trying to process the Excel rows in batches to SQL to go faster. But, my code obviously doesn't work. Any ideas?

'open DB connection using another module
Call InitializeConnection
 
    Dim varHeader As Variant, varBody As Variant, varColumn As Variant
    Dim lngNumRowsSource As Long, lngRowNbr As Long, lngBatchSize As Long, lngRowCounter As Long, lngCounter As Long
    Dim lngColCounter As Long, lngColumnNbr As Long
    Dim strDBDataType As String
 
    Set wksData = ActiveWorkbook.Sheets("DATA")
    Set r = wksData.Range("A1").CurrentRegion
    varHeader = r.Resize(1, r.Columns.Count).Value
    varBody = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count).Value
 
    lngNumRowsSource = r.Rows.Count
    lngColCounter = r.Columns.Count
    strMaintUser = "" & Environ("USERNAME") & ""
 
    lngRowNbr = 2
    lngBatchSize = 100
    strSQL = ""
 
    'Loop through all rows in the source spreadsheet
    'Subtract 1 row from row source to account for header.
    For lngRowCounter = 1 To lngNumRowsSource - 1
 
        'Create insert statements for SQL Server for each batch
        For lngCounter = 1 To lngBatchSize
 
            strErrorMessage = "Error occured while loading a batch of " & lngBatchSize & _
            " records and processing record " & lngRowCounter & "."
 
            PrimaryKey = "" & wksData.Range("A" & lngRowNbr).Value & ""
 
            strSQL = "SELECT count(*) AS record_count FROM tbl_TIC_material_master WHERE material = " & PrimaryKey
 
            Set rsRecordSet = GetRecordsfromDB(strSQL)
 
            For lngColCounter = 1 To UBound(varBody, 1)
                lngColumnNbr = varBody(1, lngColCounter)
                strDBDataType = varBody(2, lngColCounter)
                varColumn = Trim(varBody(lngRowNbr, lngColCounter))
 
                strErrorMessage = "Error occured while processing row " & lngRowCounter & " and column " & lngColumnNbr & " with datatype " & strDBDataType & " and value of " & varColumn & "."
 
                strSQL = strSQL & varColumn & ","
 
            Next lngColCounter
 
            If rsRecordSet.BOF And rsRecordSet.EOF = 0 Then
 
                strSQL = "INSERT INTO tbl_table_name (Primary_Key, Field1, Field2, Field3, Field4, Field5, Field6, Field7, Field8, Field9)" _ 
& "VALUES (" & strSQL & strMaintUser & ", CAST('" & Now() & _ 
"' AS datetime))"
 
                strSQL = ""
 
            Else
 
                strSQL = "UPDATE tbl_table_name SET " & strSQL & strMaintUser _
& ", CAST('" & Now() & "' AS datetime))" & "WHERE Primary_Key = '" _
& PrimaryKey & "'"
                strSQL = ""
 
            End If
 
        Next lngCounter
 
    lngRowNbr = lngRowNbr + 1
 
    If lngRowNbr > lngNumRowsSource - 1 Then
        Exit For
    End If
 
    Next lngRowCounter
 
    Application.StatusBar = lngRecordsAffected & " records successfully loaded to the database."
 
    Call EndDBConnection
 
    End
 
 
ErrorHandler:
    Call DisplayError(strErrorMessage, strRoutine, lngErrorNumber, strErrorDescription)
 
    Call EndDBConnection
 
    Application.StatusBar = ""