Option Explicit

              Sub main()
                  Dim firstCell As Range
                  Dim finalCell As Range
                  Dim cell As Range
                  
                  Set firstCell = Worksheets("Sheet1").Cells(2, 1)
                  Set finalCell = firstCell.End(xlDown)
                  
                  For Each cell In Range(firstCell, finalCell)
                      If cell.Value - 10 = Date Then
                          Call toSendEmail(cell.Value, cell.Offset(0, 1).Value)
                          cell.Offset(0, 2).Value = Date
                      End If
                  Next cell
              End Sub
              
              Sub toSendEmail(dateValue As Date, emailValue As String)
                  Dim appOutlook As Object
                  Dim mItem As Object
              
                  'create a new instance of Outlook
                  Set appOutlook = CreateObject("Outlook.Application")
                  Set mItem = appOutlook.CreateItem(0)
              
                  With mItem
                      .To = emailValue
                      .CC = "你的电邮"
                      .Subject = "电邮主题"
                      .HTMLBody = "您好，您的合约将会在 " & dateValue & " 到期咯!"
                   
                      '展示需要发送的电邮，需要手动发送，比较安全
                      .Display
                      
                      '直接发送电邮，不建议自动发送
                      '''.Send
                  End With
              
                  Set mItem = Nothing
                  Set appOutlook = Nothing
              End Sub