Indsæt mail header og tekst i sql database

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace
 
  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
  Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
  MsgBox "her"
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
    MessageInfo = "" & _
        "Sender : " & Item.SenderEmailAddress & vbCrLf & _
        "Sent : " & Item.SentOn & vbCrLf & _
        "Received : " & Item.ReceivedTime & vbCrLf & _
        "Subject : " & Item.Subject & vbCrLf & _
        "Size : " & Item.Size & vbCrLf & _
        "Message Body : " & vbCrLf & Item.Body
    Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")

    Dim oCon As ADODB.Connection
    Dim oRS As ADODB.Recordset
    Set oCon = New ADODB.Connection
    oCon.ConnectionString = "Provider=SQLOLEDB;Server=.\SQLEXPRESS;Database=DINDATABASE; Trusted_Connection=yes;"
    oCon.Open
    oCon.Execute "INSERT INTO Emails (Mailaddress) VALUES ('" & Item.SenderEmailAddress & "')"
    '
    oCon.Close
    If Not oCon Is Nothing Then Set oCon = Nothing

Dim oCon As ADODB.Connection
    Dim oRS As ADODB.Recordset
    Dim oCm As ADODB.Command
    Dim oPm As ADODB.Parameter
    Set oCon = New ADODB.Connection
    oCon.ConnectionString = "Provider=SQLOLEDB;Server=.\SQLEXPRESS;Database=DINDATABASE; Trusted_Connection=yes;"
    oCon.Open
    Set oCm = New ADODB.Command
    With oCm
        .ActiveConnection = oCon
        .CommandText = "INSERT INTO Emails (Mailaddress) VALUES (?)"
        .CommandType = adCmdText
        Set oPm = .CreateParameter("mailaddress", adVarChar, adParamInput, 50)
        oPm.Value = Item.SenderEmailAddress & "test"
        .Parameters.Append oPm
        .Execute
    End With
    oCon.Close
    If Not oCon Is Nothing Then Set oCon = Nothing