Macro en excel que abra una plantilla de word y copie datos de la hoja de excel

[Hola

Pues, igual necesitas leer e intentar primero tú mismo. Comienza leyendo estos tres enlaces:

https://abrahamexcel.blogspot.com/2018/02/microsoft-outlook-desde-excel-vba.html

https://abrahamexcel.blogspot.com/2018/03/exportando-archivos-excel-pdf.html

https://abrahamexcel.blogspot.com/2018/08/enviar-hojas-y-el-libro-activo-por.html

Esta macro llama una plantilla word ubicada en el Drive I:Personal... reemplaza las casillas y luego la graba en la misma ruta como .docx. luego la macro de email busca el nuevo formulario y lo envía por email.

Ahora solicito de su experiencia para que a partir del mismo excel se cree un formulario con la misma información y que a su vez se cree como pdf y que se envíe automáticamente por email tanto el formulario PDF como el libro de excel u hoja. Por que el archivo original de excel o formulario el cliente lo recibirá por email y por ende la ruta donde esta el ubicado la plantilla de word generara error. Estaré atento a sus observaciones y agradezco de su tiempo y ayuda.

MACRO FORMULARIO

Sub ExcelModificaPlantillaWord_2()

 Application.ScreenUpdating = False

Application.DisplayAlerts = False

Dim objWord As Word.Application, Form As Word.Document

Dim datos(0 To 1, 0 To 26) As String

Dim NewForm As String

On Error Resume Next

Set objWord = CreateObject("Word.Application")

objWord.DisplayAlerts = wdAlertsNone

objWord.Visible = True

Set Form = objWord.Documents.Open("I:\Personal\Macro Ejercicios\Exceptions_Form.dotm")

NewForm = Range("C7").Value & "-" & Range("K5").Value

'Captura de datos formulario exceptions_form

datos(0, 0) = "[D9]"

datos(1, 0) = Range("D9").Value

datos(0, 1) = "[H9]"

datos(1, 1) = Range("H9").Value

datos(0, 2) = "[C12]"

datos(1, 2) = Range("C12").Value

datos(0, 3) = "[C15]"

datos(1, 3) = Range("C15").Value

datos(0, 4) = "[C18]"

datos(1, 4) = Range("C18").Value

datos(0, 5) = "[C21]"

datos(1, 5) = Range("C21").Value

datos(0, 6) = "[C24]"

datos(1, 6) = Range("C24").Value

datos(0, 7) = "[C27]"

datos(1, 7) = Range("C27").Value

datos(0, 8) = "[C27]"

datos(1, 8) = Range("C27").Value

datos(0, 9) = "[C7]"

datos(1, 9) = Range("C7").Value

datos(0, 10) = "[C33]"

datos(1, 10) = Range("C33").Value

datos(0, 11) = "[F88]"

datos(1, 11) = Range("F88").Value

datos(0, 12) = "[C92]"

datos(1, 12) = Range("C92").Value

datos(0, 13) = "[C95]"

datos(1, 13) = Range("C95").Value

datos(0, 14) = "[D106]"

datos(1, 14) = Range("D106").Value

datos(0, 15) = "[H106]"

datos(1, 15) = Range("H106").Value

datos(0, 16) = "[C114]"

datos(1, 16) = Range("C114").Value

datos(0, 17) = "[E118]"

datos(1, 17) = Range("E118").Value

datos(0, 18) = "[C124]"

datos(1, 18) = Range("C124").Value

datos(0, 19) = "[K124]"

datos(1, 19) = Range("K124").Value

datos(0, 20) = "[C127]"

datos(1, 20) = Range("C127").Value

datos(0, 21) = "[M132]"

datos(1, 21) = Range("M132").Value

datos(0, 22) = "[D138]"

datos(1, 22) = Range("D138").Value

datos(0, 23) = "[H138]"

datos(1, 23) = Range("H138").Value

datos(0, 24) = "[J138]"

datos(1, 24) = Range("J138").Value

datos(0, 25) = "[D141]"

datos(1, 25) = Range("D141").Value

For I = 0 To UBound(datos, 2)

textobuscar = datos(0, I)

objWord.Selection.Move 6, -1

objWord.Selection.Find.Execute FindText:=textobuscar

While objWord.Selection.Find.Found = True

objWord.Selection.Text = datos(1, I) 'texto a reemplazar

objWord.Selection.Move 6, -1

objWord.Selection.Find.Execute FindText:=textobuscar

Wend

Next I

'Guarda el archivo 

 Form.SaveAs Filename:=""I:\Personal\Macro Ejercicios\Exceptions_Form.pdf" , FileFormat:=wdFormatXMLDocument

Form.Activate

'Form.Close

MsgBox ("Formulario Guardado"), vbInformation, «AVISO»

Application.ScreenUpdating = True

Application.DisplayAlerts = True

'wdDoc.Close

CALL EMAIL

End Sub

Macro Email

Sub email()

'Created by Julian Vesga

Dim mi_App As Object

Dim mi_Correo As Object

rutainf = ("I:\Personal\Macro Ejercicios\Exceptions_Form.docx")

Set mi_App = CreateObject("Outlook.Application")

mi_App.Session.logon

Set mi_Correo = mi_App.CreateItem(0)

ActiveWorkbook.Save

On Error Resume Next

With mi_Correo

.To = Range("H106").Value And Range("h94").Value

.CC = Range("H138").Value

.BCC = Range("H106").Value

.Subject = "Formulario" 'Range("B5").Value

.Body = "Por favor para su Autorizacion" 'Range("B6").Value

.Attachments.Add (rutainf)

'.Attachments.Add Range("B8").Value

.DeleteAfterSubmit = False

.SEND

End With

MsgBox "Email enviado con éxito"

 On Error GoTo 0

 Set mi_Correo = Nothing

Set mi_App = Nothing

 End Sub