Fejl ved CDO mail -excel

Hej,

Jeg får følgende fejl når jeg prøver at køre scriptet nedenfor.

Run-time error ´-2147220973(800040213)
Transporten kunne ikke oprette forbindelse til serveren.

Nogen som ved hvad der er galt? jeg har prøvet at ændre porten til 465, men det hjal heller ikke.

på forhånd tak

Anders


Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
   
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
   
    iConf.Load -1 ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Myusername"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Mypassword"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Mysmtpserver"
       
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
   
    strbody = "Hi there" & vbNewLine & vbNewLine & _
    "This is line 1" & vbNewLine & _
    "This is line 2" & vbNewLine & _
    "This is line 3" & vbNewLine & _
    "This is line 4"
   
    With iMsg
        Set .Configuration = iConf
        .To = "Myemail"
        .CC = ""
        .BCC = ""
        .From = """Myname"" <myemail>"
        .Subject = "Important message"
        .TextBody = strbody
        .Send
    End With
   
End Sub