Import Data From Closed Excel File To SERVER

Sub ImportDataFromClosedExcelToSQLServer()
    Dim xlCn As Object, xlRs As Object
    Dim xlFilePath As String, tableName As String, connectionString As String
    'Dim columnNames As String, rowValues As String
    Dim batchSize As Long, lastRow As Long, rCount As Long, eRow As Long
    Dim i As Long, j As Long, lastCol As Long, tableExists As Boolean

    Debug.Print "Start Time: " & Now()

    ' File path and table name configuration
    xlFilePath = "C:\Users\Rushikesh Badne\Downloads\Employee Sample Data.xlsx" ' Update as needed
    tableName = "Data"
    connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                       "Data Source=" & xlFilePath & ";" & _
                       "Extended Properties='Excel 12.0 Xml;HDR=YES';"
                       
      Set xlCn = CreateObject("ADODB.Connection")
      Set xlRs = CreateObject("ADODB.Recordset")
      xlCn.Open connectionString
      
       sqlQuery = "SELECT * FROM [Data$]"
      xlRs.Open sqlQuery, xlCn, 1, 1
    
    lastCol = xlRs.Fields.Count - 1
    lastRow = xlRs.recordCount
'      ' Check data availability in Excel
'       If xlRs.EOF Then
'          MsgBox "No data found in the Excel file!", vbExclamation
'          GoTo CleanUp
'       End If

    ' Check table existence in SQL Server
    sqlQuery = "SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_NAME = '" & tableName & "'"
    Debug.Print sqlQuery
    If cnopen(1) = False Then GoTo CleanUp
    If rsOpen() = False Then GoTo CleanUp


    'On Error Resume Next
    If rs.recordCount >= 1 Then
        tableExists = True
    Else
        tableExists = False
    End If
'    On Error GoTo 0

   If tableExists Then
        sqlQuery = "DELETE FROM " & tableName
        If rsOpen(2) = False Then GoTo CleanUp
       
    Else
       ' Create header based on Excel table Header and create table
        sqlQuery = "CREATE TABLE " & tableName & "("
        For j = 0 To xlRs.Fields.Count - 1
            sqlQuery = sqlQuery & "[" & xlRs.Fields(j).Name & "] NVARCHAR(255)"
            If j < xlRs.Fields.Count - 1 Then sqlQuery = sqlQuery & ", "
            Debug.Print sqlQuery
        Next j
        sqlQuery = sqlQuery & ");"
        If rsOpen(2) = False Then GoTo CleanUp
        MsgBox tableName & " table created successfully!"
    End If

 ' Import data to SQL Server
 '  Set BatchSize how much record in 1 batch to insert in table.
    batchSize = 2 '1000
    rCount = 1

    xlRs.MoveFirst
    Do While rCount <= lastRow
        DoEvents
        eRow = Application.Min(rCount + batchSize - 1, lastRow)
        sqlQuery = "INSERT INTO " & tableName & " ("

         'Add column names
        For j = 0 To lastCol
            sqlQuery = sqlQuery & "[" & xlRs.Fields(j).Name & "]"
            If j < lastCol Then sqlQuery = sqlQuery & ", "
        Next
        sqlQuery = sqlQuery & ") VALUES "

        ' Add row values
        For i = rCount To eRow
            DoEvents
            rowValues = "("
            For j = 0 To lastCol
                rowValues = rowValues & "'" & xlRs.Fields(j).Value & "'"
                If j < lastCol Then rowValues = rowValues & ", "
            Next
            rowValues = rowValues & "),"
            sqlQuery = sqlQuery & rowValues
            xlRs.MoveNext
            rCount = rCount + 1
            Debug.Print sqlQuery
        Next
        sqlQuery = Left(sqlQuery, Len(sqlQuery) - 1) & ";"

        Debug.Print sqlQuery
        If rsOpen(2) = False Then GoTo CleanUp
    Loop
    
    Debug.Print sqlQuery
    MsgBox "Data added successfully!"

CleanUp:
    ' Close and clean up
    On Error Resume Next
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
    xlRs.Close: Set xlRs = Nothing
    xlCn.Close: Set xlCn = Nothing
    Debug.Print "End Time: " & Now()
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical
    Resume CleanUp
End Sub

Loading

Scroll to Top