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