Excel 2007 imsg error on .send

[Andy16H]

I have a sheet that sends emails that has been working correctly for years. I just got a new computer with windows 7 and installed excel 2007. I have the following code and it gets stuck on .send on the new computer. It works fine on other windows 7 excel 2007 computers. Please help

Sub EmailSheet_Click()
 
 Dim wbTo As Workbook, wbFrom As Workbook
    Dim lngLastRow As Long
    Application.ScreenUpdating = False
    Set wbFrom = ThisWorkbook
'check if H17:H19 is all zeros, then exit sub if so:
If Application.CountIf(wbFrom.Sheets(1).Range("H17:H19"), 0) = 3 Then Exit Sub
'otherwise, something will need to be pasted:
    Set wbTo = Workbooks.Open("C:\Users\AndyH\Desktop\Safe Register.xls")
With wbTo
  With .Sheets(1)
    If wbFrom.Sheets(1).Range("H17") <> 0 Then
      lngLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
      .Cells(lngLastRow + 1, "E") = wbFrom.Sheets(1).Range("H17")
      .Cells(lngLastRow + 1, "B") = wbFrom.Sheets(1).Range("H13")
      .Cells(lngLastRow + 1, "C") = wbFrom.Sheets(1).Range("G17")
    End If
  End With
  With Sheets(2)
    If wbFrom.Sheets(1).Range("H19") <> 0 Then
        lngLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Cells(lngLastRow + 1, "E") = wbFrom.Sheets(1).Range("H19")
        .Cells(lngLastRow + 1, "B") = wbFrom.Sheets(1).Range("H13")
        .Cells(lngLastRow + 1, "C") = wbFrom.Sheets(1).Range("G19")
    End If
  End With
  With Sheets(3)
    If wbFrom.Sheets(1).Range("H18") <> 0 Then
         lngLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
         .Cells(lngLastRow + 1, "E") = wbFrom.Sheets(1).Range("H18")
          .Cells(lngLastRow + 1, "B") = wbFrom.Sheets(1).Range("H13")
          .Cells(lngLastRow + 1, "C") = wbFrom.Sheets(1).Range("G18")
    End If
  End With
    .Close True
End With
    Application.ScreenUpdating = True
     
    ChDir "c:\Temp1"
    ActiveWorkbook.SaveCopyAs Filename:=Range("FF1").Text & " Closing Sheet" & ".xls"
    
    
    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
    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") = "******@*****.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*******"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    
    
    With iMsg
        Set .Configuration = iConf
        .To = "***@*****.com;***@*****.com"
        .CC = ""
        .BCC = ""
        .From = """****"" <*****@*****.com>"
        .Subject = "Closing Numbers"
        .TextBody = "Attached you will find the closing numbers from last night." & vbCrLf & _
        "" & vbCrLf & _
        "Thanks" & vbCrLf & _
        "" & vbCrLf & _
        "" & vbCrLf & _
        "Management" & vbCrLf & _
        "" & vbCrLf & _
        "This is a auto generated email, please do not reply."
        .AddAttachment "c:\Temp1\" & Range("FF1").Text & " Closing Sheet" & ".xls"
        .send
    
    Kill Range("FF1").Text & " Closing Sheet" & ".xls"
    
    
    ActiveWorkbook.Saved = True
    Application.Quit
      
   End With
End Sub

 

[Andy16H]

The error message that I'm getting is:
Run-time error '-2147220973 (80040213)':
The transport failed to connect to the server.

 

[Andy16H]

Changed the port from 25 to 465 and it works fine.