INSERT Excel Worksheet data INTO SQL Server

[mlangen]

Very useful code for taking data from an Excel Worksheet and Insert it into a SQL Server Table.

I could not find a complete solution so I am posting one
Key Words: SQL INSERT VBA DATABASE

Sub CreateInsertScript()
Dim Row As Integer
Dim Col As Integer
Dim conn As ADODB.Connection
Dim statement As String
' Create a connection object.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection
' Provide the connection string.
Dim strConn As String
'Use the SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;"
'Connect to the Pubs database on the local server.
strConn = strConn & "DATA SOURCE=SQL00099T95;INITIAL CATALOG=TestMetrics;"
'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"
'Now open the connection.
cnPubs.Open strConn
'----------------------------------------------------
'----------------------------------------------------
   ' Create the Excel application.
    Set excel_app = CreateObject("Excel.Application")
'----------------------------------------------------
'----------------------------------------------------
'To store all the columns available in the current active sheet
Dim ColNames(100) As String
Col = 1
Row = 1
Dim ColCount As Integer
ColCount = 0
'Get Columns from the sheet
Do Until ActiveSheet.Cells(Row, Col) = "" 'Loop until you find a blank.
ColNames(ColCount) = "[" + ActiveSheet.Cells(Row, Col) + "]"
ColCount = ColCount + 1
Col = Col + 1
    Loop
    ColCount = ColCount - 1
    'Inputs for the starting and ending point for the rows
    Row = InputBox("Give the starting Row No.")
    Dim MaxRow As Integer
    MaxRow = InputBox("Give the Maximum Row No.")
    
    Dim CellColCount As Integer
    Dim StringStore As String 'Temporary variable to store partial statement
    Dim SQL_statement As String
    Do While Row <= MaxRow
        StringStore = ""
        CellColCount = 0
        'ActiveSheet.Name will give the current active sheet name
        'this can be treated as table name in the database
        StringStore = StringStore + "insert into TestMetrics.dbo.test ( "
        Do While CellColCount <= ColCount
            StringStore = StringStore + ColNames(CellColCount)
            'To avoid "," after last column
            If CellColCount <> ColCount Then
                StringStore = StringStore + " , "
            End If
            CellColCount = CellColCount + 1
        Loop
        
        'Here it will create "insert into [TableName] ( [Col1] , [Col2] , ..."
        SQL_statement = StringStore + " ) "
        
        'For printing the values for the above columns
        StringStore = " values( "
        CellColCount = 0
        Do While CellColCount <= ColCount
            StringStore = StringStore + " '" + CStr(ActiveSheet.Cells(Row, CellColCount + 1)) + "'"
            If CellColCount <> ColCount Then
                StringStore = StringStore + ", "
            End If
            CellColCount = CellColCount + 1
        Loop
        'Here it will print "values( 'value1', 'value2', ..."
        SQL_statement = SQL_statement & StringStore & ");"
        
        'MsgBox SQL_statement
    ' Create a recordset object.
        Dim rsPubs As ADODB.Recordset
        Set rsPubs = New ADODB.Recordset
    
'----------------------------------------------------
'----------------------------------------------------
'Run Your SQL Command :)
        
        With rsPubs
    ' Assign the Connection object.
    .ActiveConnection = cnPubs
    ' Extract the required records.
 'for a query change it to .Open "INSERT T-SQL"
        
            .Open SQL_statement
End With
     Row = Row + 1
    Loop
   
'Close up your database connection
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
    
 End Sub