从Excel发送Outlook电子邮件,将最后一行范围文本放入正文消息中

时间:2017-07-24 20:32:25

标签: excel vba excel-vba email outlook

我想从我的Excel电子表格中发送一封电子邮件,其中包含一条小消息,其中包含从A列到G列的最后一行。

我尝试将上一行范围添加到以下代码中但未成功。

你能帮忙吗?

Sub Mail_LastRowRange_Outlook()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Thanks for your help" & '**I Would like to insert_
           my last row range from column A to G in here**

On Error Resume Next
With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Looking for a solution"
    .Body = strbody
    .Attachments.Add ("C:\test.txt")
    .Send   
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

3 个答案:

答案 0 :(得分:1)

Sub test1()
  Dim lastRow As Long
  'get last row from column A of worksheet with 'codename' Sheet1
  lastRow = getLastRow(Sheet1, 1)

  Dim r As Range
  Set r = Sheet1.Range("A" & lastRow & ":G" & lastRow)

  Dim str As String
  'Join the cell texts with a space - lazy coding...
  str = Join(Application.Transpose(Application.Transpose(r.Value2)), " ")

  MsgBox str
End Sub


Public Function getLastRow(ws As Worksheet, Optional col As Long) As Long
  Dim arr As Variant

  If col > 0 Then
        arr = Intersect(ws.UsedRange, ws.Columns(col)).Value2
  Else
        arr = ws.UsedRange.Value2
  End If

  Dim i As Long, j As Long
  For i = UBound(arr) To 1 Step -1
        For j = UBound(arr, 2) To 1 Step -1
              If Len(arr(i, j)) > 0 Then
                    getLastRow = i + ws.UsedRange.Row - 1
                    Exit Function
              End If
        Next j
  Next i
End Function

上面的函数是 最强大的函数,用于获取工作表/列中的最后一行实际数据值。其他一切都很容易受到攻击,包括Range.Find("*", , , , , xlPrevious),它在过滤的ListObject

中容易受到activeCell的攻击

下面的函数容易受到过滤行,最后一行有数据等的影响。

Public Function getLastRow2(ws As Worksheet, col As Long) As Long
    getLastRow2 = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
End Function

答案 1 :(得分:0)

这应该有效,只要A列中没有空白单元格,从单元格A1到最后一行,并且在A列中有数据。替换您拥有的行" strbody = ....&#34 ;所有这一切。

Cells(1,1).Select
Selection.End(xlDown).Select

Dim s As String
s = ActiveCell.Value     'A
ActiveCell.Offset(0, 1).Select
s = s & ActiveCell.Value 'B
ActiveCell.Offset(0, 1).Select
s = s & ActiveCell.Value 'C
ActiveCell.Offset(0, 1).Select
s = s & ActiveCell.Value 'D
ActiveCell.Offset(0, 1).Select
s = s & ActiveCell.Value 'E
ActiveCell.Offset(0, 1).Select
s = s & ActiveCell.Value 'F
ActiveCell.Offset(0, 1).Select
s = s & ActiveCell.Value 'G

strbody = "Thanks for your help" & s

答案 2 :(得分:0)

确定特定行,并创建一个范围对象并对其进行迭代,例如:

    Dim rng As range
    Dim item As range
    Dim row As Long

    Set rng = range(Cells(row, 1), Cells(row, 7))

    For Each item In rng
        strBody = strBody & " " & item
    Next item