Insert visible cell range into Outlook reminder

[CWBlack]

I am trying to create a reminder with the visible cells in a range in the body of the reminder. I have been able to create teh reminder with text and single cell contents, but not a range. Here is what I have right now. Thanks in advance.

Sub Removal_Reminder()


    Dim appOL As Object
    Dim objReminder As Object
    Dim rng As Range


    Set rng = Application.Intersect(ActiveSheet.UsedRange, Range("C4:G100"))
    rng.SpecialCells(xlCellTypeVisible).Select
    
    Set appOL = GetObject(, "Outlook.application")
    Set objReminder = appOL.CreateItem(1) ' olAppointmentItem
     
    objReminder.Start = Worksheets("Reminder").Range("a1") ' 4/Feb/2004 18:30
    objReminder.Duration = Worksheets("Reminder").Range("b1") ' 30
    objReminder.Subject = Worksheets("Reminder").Range("c1") ' subject text
    objReminder.body = rng
    objReminder.ReminderSet = True
    objReminder.Save
End Sub

 

[daverunt]

Hi,,

I think you have to convert the range to text to enter into the body.
There may be much cleaner or easier ways to do this but this should get you started.

    Dim strtable As String


........
........
rng.SpecialCells(xlCellTypeVisible).Select - not needed

    FirstRow = 4
    LastRow = 100
    FirstCol = 3 'C
    LastCol = 7 ' G

For r = FirstRow To LastRow
For c = FirstCol To LastCol
For Each cell In Cells(r, c)
strtable = strtable & "  " & cell.Value
Next
Next
strtable = strtable & vbNewLine
Next


Set appOL = GetObject(, "Outlook.application")
......etc
objReminder.body = strtable