littleiitin
11-03-2011, 12:28 PM
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:
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
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:
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