VBA Outlook and Word Library - Late Binding help

[Mallesh23]

Hi Team,


Please assist in converting below outlooks and word library code to late binding.
Below is attempted Code.

Sub Outlook_Late_Binding()


    Dim OutApp As Object
    Dim OutMail As Object


    Dim ProcurementStatusSh As Worksheet
    Dim WorkStatusSh As Worksheet
    Dim ProjectStatusSh As Worksheet


[B]    Dim wordDocument As Word.Document[/B]
[B]    Dim wordRng As Word.Range[/B]


    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
       
    Set ProcurementStatusSh = ThisWorkbook.Sheets("Sheet1")
    Set WorkStatusSh = ThisWorkbook.Sheets("Sheet2")
    Set ProjectStatusSh = ThisWorkbook.Sheets("Sheet3")


    On Error Resume Next
    With OutMail
        .Display
        .To = "Recipient@email.com"
        .Subject = "project - Today's EoD Status : " & Format(Date, "dd-mmm-yyyy")
[B]        Set wordDocument = OutApp.ActiveInspector.WordEditor[/B]
[B]        wordDocument.Range.Text[/B] = "Recipient," & vbNewLine & vbNewLine & _
            "Table1," & vbNewLine & "Procurement status," & vbNewLine


        ProcurementStatusSh.Range("A1").CurrentRegion.Copy
[B]        Set wordRng = wordDocument.Range[/B]
[B]        wordRng.Collapse Direction:=wdCollapseEnd[/B]
[B]        wordRng.Collapse[/B]
[B]        wordRng.PasteAndFormat wdFormatOriginalFormatting[/B]


[B]        wordDocument.Range.InsertAfter [/B]vbNewLine & "Table2," & vbNewLine


        WorkStatusSh.Range("A1").CurrentRegion.Copy
[B]        Set wordRng = wordDocument.Range[/B]
[B]        wordRng.Collapse Direction:=wdCollapseEnd[/B]
[B]        wordRng.PasteAndFormat wdFormatOriginalFormatting[/B]


        wordDocument.Range.InsertAfter vbNewLine & "Table3," & vbNewLine


        ProjectStatusSh.Range("A1").CurrentRegion.Copy
[B]        Set wordRng = wordDocument.Range[/B]
[B]        wordRng.Collapse Direction:=wdCollapseEnd[/B]
[B]        wordRng.PasteAndFormat wdFormatOriginalFormatting[/B]


        wordDocument.Range.InsertAfter vbNewLine & "Let me know, if any." & vbNewLine & vbNewLine & "Thanks & Regards!!!"
        .Display
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.CutCopyMode = False
    


End Sub

Thanks
mg

 

[ZVI]

Hi,
Try this:

Sub Outlook_Late_Binding()

    Const wdCollapseEnd = 0, wdFormatOriginalFormatting = 16
       
    Dim OutApp As Object
    Dim OutMail As Object

    Dim ProcurementStatusSh As Worksheet
    Dim WorkStatusSh As Worksheet
    Dim ProjectStatusSh As Worksheet

    Dim wordDocument As Object 'Word.Document
    Dim wordRng As Object ' Word.Range
    
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    Set OutMail = OutApp.CreateItem(0)
       
    Set ProcurementStatusSh = ThisWorkbook.Sheets("Sheet1")
    Set WorkStatusSh = ThisWorkbook.Sheets("Sheet2")
    Set ProjectStatusSh = ThisWorkbook.Sheets("Sheet3")

    On Error Resume Next
    With OutMail
        .Display
        .To = "Recipient@email.com"
        .Subject = "project - Today's EoD Status : " & Format(Date, "dd-mmm-yyyy")
        Set wordDocument = OutApp.ActiveInspector.WordEditor
        wordDocument.Range.Text = "Recipient," & vbNewLine & vbNewLine & _
            "Table1," & vbNewLine & "Procurement status," & vbNewLine

        ProcurementStatusSh.Range("A1").CurrentRegion.Copy
        Set wordRng = wordDocument.Range
        wordRng.Collapse Direction:=wdCollapseEnd
        wordRng.Collapse
        wordRng.PasteAndFormat wdFormatOriginalFormatting

        wordDocument.Range.InsertAfter vbNewLine & "Table2," & vbNewLine

        WorkStatusSh.Range("A1").CurrentRegion.Copy
        Set wordRng = wordDocument.Range
        wordRng.Collapse Direction:=wdCollapseEnd
        wordRng.PasteAndFormat wdFormatOriginalFormatting

        wordDocument.Range.InsertAfter vbNewLine & "Table3," & vbNewLine

        ProjectStatusSh.Range("A1").CurrentRegion.Copy
        Set wordRng = wordDocument.Range
        wordRng.Collapse Direction:=wdCollapseEnd
        wordRng.PasteAndFormat wdFormatOriginalFormatting

        wordDocument.Range.InsertAfter vbNewLine & "Let me know, if any." & vbNewLine & vbNewLine & "Thanks & Regards!!!"
        '.Display
    
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.CutCopyMode = False

End Sub

Regards