anexo te envio codigo analizalo y aplicalo segun tus necesidades.Sub EnviarCorreo()
Dim Detalle As Recordset
Set Detalle = DDetalle.Recordset
Detalle.MoveFirst
CR1.SelectionFormula = "{plan.plan}='" & TxtPlan.Text & "'"
On Error GoTo Reporte_Err
CR1.Formulas(0) = "Username = ' " & Username & "'"
CR1.WindowTitle = "Impresión de inicio de promoción: " & TxtPlan & " de " & TxtCliente
CR1.Destination = crptToFile
CR1.PrintFileName = "c:\plan\plan.html"
CR1.WindowMaxButton = True
CR1.Action = 1
Do While Not Detalle.EOF
If Detalle.Fields("sucursal") <> "" Then
'Envio del Plan a las sucursales indicadas en el Dbgrid1
CorreoSesion.Username = Username
CorreoSesion.NewSession = True
CorreoSesion.DownLoadMail = False
CorreoSesion.SignOn
CorreoMensajes.SessionID = CorreoSesion.SessionID
CorreoMensajes.MsgIndex = -1
CorreoMensajes.RecipDisplayName = Detalle.Fields("sucursal")
CorreoMensajes.ResolveName
On Error GoTo Envio_Mail_Err
CorreoMensajes.MsgSubject = "Inicio de Plan, promoción: "