Upload Excel Data to SQL Table
Code:
Sub ExceltoSQLUpload(gc_strServerAddress As String, gc_strDatabase As String, strTableName As String)
Dim Cnn As Object
Dim wbkOpen As Workbook
Dim fd As FileDialog
Dim objfl As Variant
Dim rngName As Range
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.ButtonName = "Open"
.AllowMultiSelect = False
.Filters.Add "Text Files", "*.xlsm,*.xlsx;*.xls", 1
.Title = "Select Raw Data File...."
.InitialView = msoFileDialogViewThumbnail
If .Show = -1 Then
For Each objfl In .SelectedItems
.Execute
Next objfl
End If
On Error Goto 0
End With
Set wbkOpen = ActiveWorkbook
Set fd = Nothing
Set rngName = Application.InputBox("Select Range to Upload in newly opended file", , , , , , , 8)
rngName.Name = "TempRange"
strFileName = wbkOpen.FullName
Set Cnn = CreateObject("ADODB.Connection")
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFileName & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes"";"
nSQL = "INSERT INTO [odbc;Driver={SQL Server};" & _
"Server=" & gc_strServerAddress & ";Database=" & gc_strDatabase & "]." & strTableName
nJOIN = " SELECT * from [TempRange]"
Cnn.Execute nSQL & nJOIN
MsgBox "Uploaded Successfully", vbInformation, "Say Thank you to me"
wbkOpen.Close
Set wbkOpen = Nothing
End Sub
How to Use:
Code:
Sub CheckUpload()
'==Precaution: Please Make sure Table Exists and Raw Data Headers must be Same as Table Headers====
'Call ExceltoSQLUpload("ServerName", "Database Name", "Table Name")
Call ExceltoSQLUpload("xxxxx", "yyyy", "zzzzz")
End Sub
