none
How do copy paste last row for table range on outlook? RRS feed

  • Question

  • how do I last row for table range instead of giving a specific range value for outlook ? (X:X) 
    Public Sub Insert_Charts_In_New_Email1()
    
    
    Dim outApp As Object 'Outlook.Application ( to sent workbook)
    Dim outMail As Object 'Outlook.MailItem   ( to open outlook)
    Dim wEditor As Object 'Word.Document (responsible for charts)
    Dim wRange As Object 'Word.Range ( for texts)
    Dim chartsSheet As Object
    Dim rng_dear As Range
    Dim rng1_overalltext As Range
    Dim rng2_testexec As Range
    Dim rng3_critmajor As Range
    Dim rng4_jiralist As Range
    Dim rng5_overall As Range
    Dim rng6_detaildefectreport As Range
    Dim rng7_ageingdefectreport As Range
    Dim rng8_thanks As Range
    Dim chartObj As Object
    
    'Setting named Sheets
    
    Set chartsSheet = Sheets("Defects")
    Set chartsSheet2 = Sheets("Test Execution (Manual)")
    Set chartsSheet3 = Sheets("Ageing JIRAs")
    Set chartsSheet4 = Sheets("JIRA_List")
    Set chartsSheet5 = Sheets("Summary-Guidelines")
    
    
    'Only send the visible cells in the selection for table
    
    Set rng_dear = Sheets("Summary-Guidelines").Range("B4:E8").SpecialCells(xlCellTypeVisible)
    Set rng1_overalltext = Sheets("Summary-Guidelines").Range("B18:F32").SpecialCells(xlCellTypeVisible)
    Set rng5_overall = Sheets("Summary-Guidelines").Range("Overall_Test_Status").SpecialCells(xlCellTypeVisible)
    Set rng2_testexec = Sheets("Test Execution (Manual)").Range("A58:L64").SpecialCells(xlCellTypeVisible)
    Set rng3_critmajor = Sheets("Defects").Range("A61:F64").SpecialCells(xlCellTypeVisible)
    Set rng6_detaildefectreport = Sheets("Defects").Range("A5:C5").SpecialCells(xlCellTypeVisible)
    Set rng4_jiralist = Sheets("JIRA_List").Range("A10:L180").SpecialCells(xlCellTypeVisible)
    Set rng7_ageingdefectreport = Sheets("Ageing JIRAs").Range("A1:E3").SpecialCells(xlCellTypeVisible)
    Set rng8_thanks = Sheets("Ageing JIRAs").Range("H38:H40").SpecialCells(xlCellTypeVisible)
    
    
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    
    Dim strbody As String
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    
    
    
    With outMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = Sheets("Summary-Guidelines").Range("C2").Value & " - " & Sheets("Summary-Guidelines").Range("C3").Value & " - " & "Status as of " & Format(Date, "dd/mm/yyyy")
    
    'Put in table '
    .HTMLBody = RangetoHTML(rng_dear) & RangetoHTML4(rng5_overall) & RangetoHTML0(rng1_overalltext) & RangetoHTML5(rng6_detaildefectreport) & RangetoHTML1(rng2_testexec) & "<br>" & Sheets("Defects").Range("A7").Value & "<br>" & "<br>" & Sheets("Defects").Range("A35").Value & RangetoHTML2(rng3_critmajor) & "<br>" & Sheets("Defects").Range("A68").Value & "<br>" & "<br>" & Sheets("Summary-Guidelines").Range("B44").Value & RangetoHTML3(rng4_jiralist) & RangetoHTML6(rng7_ageingdefectreport) & "<br>" & Sheets("Ageing JIRAs").Range("H34").Value & "<br>" & Sheets("Ageing JIRAs").Range("H35").Value & "<br>" & Sheets("Ageing JIRAs").Range("H36").Value & RangetoHTML7(rng8_thanks)
    
    .Display
    End With
    
    
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    
    Set outMail = Nothing
    Set outApp = Nothing
    
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    
    
    Set wEditor = outApp.ActiveInspector.WordEditor
    Set wRange = wEditor.Application.ActiveDocument.Content
    
    
    wRange.Collapse 1 'Direction:=wdCollapseStart
    
    wRange.InsertAfter " " & vbNewLine
    wRange.Collapse 0 'Direction:=wdCollapseEnd
    
    'Putting charts in outlook
    
    Set chartObj = chartsSheet2.ChartObjects("Chart 1")
    Insert_Resized_Chart chartObj, wRange
    wEditor.Application.ActiveDocument.InlineShapes(1).Width = 850
    wEditor.Application.ActiveDocument.InlineShapes(1).Height = 300
    wRange.Collapse 0 'Direction:=wdCollapseEnd
    
    
    Set chartObj = chartsSheet.ChartObjects("Chart 1")
    Insert_Resized_Chart chartObj, wRange
    wEditor.Application.ActiveDocument.InlineShapes(2).Width = 400
    wEditor.Application.ActiveDocument.InlineShapes(2).Height = 200
    
    Eng Sub

    Monday, July 17, 2017 9:33 AM

All replies

  • Public Sub Insert_Charts_In_New_Email1()
    
    Dim rng4_jiralist As Range
    Dim outApp As Object 'Outlook.Application ( to sent workbook)
    Dim outMail As Object 'Outlook.MailItem   ( to open outlook)
    Dim wEditor As Object 'Word.Document (responsible for charts)
    Dim wRange As Object 'Word.Range ( for texts)
    Dim chartObj As Object
    
    Set rng4_jiralist = Sheets("JIRA_List").Range("A10:L180").SpecialCells(xlCellTypeVisible)
    
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    
    Dim strbody As String
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    
    With outMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = Sheets("Summary-Guidelines").Range("C2").Value & " - " & Sheets("Summary-Guidelines").Range("C3").Value & " - " & "Status as of " & Format(Date, "dd/mm/yyyy")
    
    'Put in table '
    .HTMLBody = RangetoHTML5(rng4_jiralist)
    .Display
    End With
    
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    
    Set outMail = Nothing
    Set outApp = Nothing
    
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    
    Set wEditor = outApp.ActiveInspector.WordEditor
    Set wRange = wEditor.Application.ActiveDocument.Content
    
    wRange.Collapse 1 'Direction:=wdCollapseStart
    
    wRange.InsertAfter " " & vbNewLine
    wRange.Collapse 0 'Direction:=wdCollapseEnd
    
    Eng Sub
    
    Function RangetoHTML3(rng4_jiralist As Range)
    ' By Ron de Bruin.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    'Copy the range and create a new workbook to past the data in
    rng4_jiralist.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
    End With
    
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
    SourceType:=xlSourceRange, _
    Filename:=TempFile, _
    Sheet:=TempWB.Sheets(1).Name, _
    Source:=TempWB.Sheets(1).UsedRange.Address, _
    HtmlType:=xlHtmlStatic)
    .Publish (True)
    End With
    
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML3 = ts.ReadAll
    ts.Close
    RangetoHTML3 = Replace(RangetoHTML3, "align=center x:publishsource=", _
    "align=left x:publishsource=")
    
    'Close TempWB
    TempWB.Close savechanges:=False
    
    'Delete the htm file we used in this function
    Kill TempFile
    
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
    
    End Function
    

    how do I last row for table range instead of giving a specific range value for outlook ? Instead of

    Set rng4_jiralist = Sheets("JIRA_List").Range("A10:L180").SpecialCells(xlCellTypeVisible)


    Monday, July 17, 2017 9:59 AM
  • Hi keirax3,

    I can see that you had copy the many ranges from the worksheet.

    so here I assume that instead of setting the range you want to get the last row of the sheet.

    for that , you can use code like below.

    Dim sht As Worksheet
    Dim LastRow As Long
    
    Set sht = ThisWorkbook.Worksheets("Sheet1")
    
    
      LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    
    'Using UsedRange
    
      sht.UsedRange 'Refresh UsedRange
      LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
    
    'Using Table Range
    
      LastRow = sht.ListObjects("Table1").Range.Rows.Count
    
    'Using Named Range
    
      LastRow = sht.Range("MyNamedRange").Rows.Count
    
    'or
    
      LastRow = sht.Range("A1").CurrentRegion.Rows.Count
    
    

    you can try to use the one which is suitable for you.

    if I misunderstand something in your requirement then let me know about that, I will try to provide further suggestions to solve the issue.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, July 19, 2017 2:56 AM
    Moderator