Insertar últimos datos de un archivo en excel a una base de datos

Pido de su gran sabiduría para que me puedan ayudar a lo siguiente.

Actualmente tengo una macro, la cual esta configurada en outlook, esta macro funciona para extraer los campos de, Remitente, destinatario, Asunto, Cuerpo del mensaje, Hora y fecha de recibido, automáticamente al recibir un nuevo mail esta macro exporta estos datos a un archivo en excel. El código de la Macro en Outlook es este.
Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim iDefault As Long
'Declare registry
Dim sKey As String
Dim lRegValue As Long
Dim sAppName As String
Dim sSection As String
'Set name of registry keys
sAppName = "Outlook"
sSection = "received"
sKey = "Current Value Number XLS"
iDefault = 2
lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF, strColG As String
' Get Excel set up
'the path of the workbook
strPath = "C:\1-Tests\test.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Hoja1")
' Process the message record
On Error Resume Next
'collect the fields
strColB = olItem.SenderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
strColE = olItem.Body
strColF = olItem.To
strColG = olItem.ReceivedTime
'write them in the excel sheet
xlSheet.Range("B" & lRegValue) = strColB
xlSheet.Range("c" & lRegValue) = strColC
xlSheet.Range("d" & lRegValue) = strColD
xlSheet.Range("e" & lRegValue) = strColE
xlSheet.Range("f" & lRegValue) = strColF
xlSheet.Range("g" & lRegValue) = strColG
'Save registry row increment
SaveSetting sAppName, sSection, sKey, lRegValue + 1
xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If
Set olItem = Nothing
Set obj = Nothing
Set currentExplorer = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

Me gustaría que además de que se extraiga la información y se guarde en Excel, esta información automáticamente se guarde en una base de datos, cada que se guarde un nuevo registro se suba a esta base de datos.