Enable the Reference Tool

In your VBA Editor, go to the menu Tools > Reference and tick "Microsoft ActiveX Data Objects 6.0 Library"

Module

Create a new module

Create a new module in your file by right-clicking on "Modules" and selecting "Insert > Module"

VBA Code (Visual Basic)

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

Excel VBA
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
  • No labels