Private Sub cmdEmail_Click()
'Definimos las variables de los distintos objetos
Dim Olk As Outlook.Application, Itm As Outlook.MailItem
Dim Wrd As Word.Application, Doc As Word.Document
Dim Tbl As Word.Table
Dim Rst As DAO.Recordset
Dim WrdVis As Boolean
Const Asunto = "Ventas" 'Definimos una constante para el asunto. También podría ser variable
Set Olk = Outlook.Application 'Asignamos el objeto Outlook
Set Itm = Olk.CreateItem(olMailItem) 'En él creamos un nuevo email
Set Rst = Me.Ventas_Subformulario.Form.RecordsetClone 'Asignamos a la variable el recorset del subformulario
On Error Resume Next 'Guardamos el estado visible de word para luego
WrdVis = Word.Application.Visible 'Si estuviese cerrado se producirá un error que evitamos
On Error GoTo 0 'con On Error
'Buscamos el email del vendedor y lo asignamos a To:
Itm.To = DLookup("Email", "Vendedores", "IdVendedor = " & Me.IdVendedor)
Itm.Subject = Asunto 'Asignamos el asunto
Itm.BodyFormat = olFormatRichText 'Le damos formato de texto enriquecido
Itm.Display 'Y lo visualizamos. En este momento Word crea un documento para la edición del mensaje
Set Wrd = Word.Application 'Asignamos Word a la variable Wrd, sólo por comodidad
Set Doc = Wrd.Documents(Asunto) 'Asignamos el documento
Doc.Activate 'y lo activamos
With Wrd.Selection 'Procedemos a escribir el él dando los formatos que queramos
'Creo que se entiende vien qué hace cada cosa
.Style = "Normal"
.TypeText "Estimado/a " & Me.Vendedor & ":"
.TypeParagraph
.TypeParagraph
.ParagraphFormat.Alignment = wdAlignParagraphJustify
.TypeText "Por el presente te adjunto el resumen de ventas de este mes a fin de que procedas " & _
"a su revisión. Si observas alguna incorrección ponte en contacto con tu jefe/a de ventas."
.TypeParagraph
.TypeParagraph
Set Tbl = Wrd.Selection.Tables.Add(Wrd.Selection.Range, 1, 3) 'Aquí creamos una tabla y la asignamos
'a la variable Tbl
With Tbl 'Ponemos los bordes
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = wdColorAutomatic
End With
End With
.TypeText "Fecha Venta" 'Vamos llenando la tabla celda a celda con los títulos
.MoveRight wdCell, 1
.TypeText "Coche"
.MoveRight wdCell, 1
.TypeText "Precio"
.ParagraphFormat.Alignment = wdAlignParagraphRight
Rst.MoveFirst 'Recorremos los registros del subformulario
Do While Not Rst.EOF
.MoveRight wdCell, 1 'y llenamos la tabla con sus datos
.TypeText Rst!FechaVenta
.MoveRight wdCell, 1
.TypeText Rst!Coche
.MoveRight wdCell, 1
.ParagraphFormat.Alignment = wdAlignParagraphRight
.TypeText Format(Rst!Precio, "#,##0.00 €")
Rst.MoveNext
DoEvents
Loop
.MoveDown wdLine 'Salimos de la tabla
.TypeParagraph 'y completamos con la despedida
.TypeText "Un cordial saludo,"
.TypeParagraph
.TypeParagraph
.TypeText "Juan Romero"
.TypeParagraph
.TypeText "Jefe General de Ventas"
End With
Wrd.Visible = False 'Hacemos invisible Word para que se active Access ya que no
'tiene un método .Activate como tiene Word
If MsgBox("¿Deseas enviar el email?. Requiere confirmación en Outlook pasados unos segundos.", _ vbYesNo + vbQuestion) = vbYes Then
'Si contestamos que sí
On Error Resume Next
'se envía el email
Itm.Send
'y dejamos Word como estaba al principio
Wrd.Visible = WrdVis
Else
'si no, activamos el correo para poder hacer correciones
'y enviarlo a mano, p.e.
Wrd.Visible = True
Wrd.Activate
End If
'Cerramos el recordset
Rst.Close
'y vaciamos las variables de objeto
Set Rst = Nothing
Set Olk = Nothing
Set Tbl = Nothing
Set Doc = Nothing
Set Itm = Nothing
Set Olk = Nothing
Set Wrd = Nothing
End Sub
