In your VBA Editor, go to the menu Tools > Reference and tick "Microsoft ActiveX Data Objects 6.0 Library"
Create a new module in your file by right-clicking on "Modules" and selecting "Insert > Module"
The following script collects 200 (customisable of course) rows of data into a SQL Insert statement for running it against the SQL Server. By doing this, you reduce the number of executions on the server and thereby increasing the performance of the data import.
Input the following example code to get started on your SQL Server Integration
Sub DatabaseExport() Dim DatabaseServer, DatabaseName, Environment, SQLUsername, SQLPassword, SQL As String Dim conn As New ADODB.Connection Dim r, s As Long Dim DateFrom, DateTo, ReportingDate As String Dim Column1, Column2, Column3 as String Application.ScreenUpdating = False DatabaseServer = Sheets("Lists").Cells(2, 2).Value DatabaseName = Sheets("Lists").Cells(3, 2).Value Environment = Sheets("Lists").Cells(4, 2).Value SQLUsername = Sheets("Lists").Cells(5, 2).Value SQLPassword = Sheets("Lists").Cells(6, 2).Value If Environment = "Development" Then conn.Open "Driver={SQL Server Native Client 11.0};Server=" & DatabaseServer & ";Database=" & DatabaseName & ";User ID=" & SQLUsername & ";Password=" & SQLPassword & ";" Else conn.Open "Driver={SQL Server Native Client 11.0};Server=" & DatabaseServer & ";Database=" & DatabaseName & ";Trusted_Connection=yes;" End If conn.CommandTimeout = 300 Sheets("Sheet1").Select ReportingDate = Format(Date, "YYYY-MM-DD") SQL = "DELETE FROM <TABLE> WHERE DateFrom>='" & ReportingDate & "'" conn.Execute (SQL) SQL = "UPDATE P SET P.DateTo='" & Format(DateAdd("d", -1, Date), "YYYY-MM-DD") & "' FROM <TABLE> P WHERE P.DateTo='2999-12-31'" conn.Execute (SQL) r = 2 Do Until Cells(r, 1).Value = "" Sheets("Sheet1").Select s = r SQL = "INSERT INTO <TABLE> ([DateFrom],[DateTo],[<COLUMN1>],[<COLUMN2>],[<COLUMN3>]) VALUES " Do Until Cells(s, 1).Value = "" Or s >= r + 200 DateFrom = Format(Date, "YYYY-MM-DD") DateTo = "2999-12-31" Column1 = Cells(s, 1).Value Column2 = Cells(s, 2).Value Column3 = Cells(s, 3).Value SQL = SQL & "('" & DateFrom & "','" & DateTo & "'," & Column1 & ",'" & Column2 & "'," & Column3 & ")," s = s + 1 Loop SQL = Left(SQL, Len(SQL) - 1) conn.Execute (SQL) r = r + 200 Loop ' Home Screen and Close Connection Sheets("Sheet1").Select conn.Close Set conn = Nothing Application.ScreenUpdating = True End Sub |