Easy VBA Question

concreteinterface

Board Regular
Joined
Jul 10, 2008
Messages
144
I am trying to make multiple reminders in Outlook for phasing of projects. Here is what I have so far:

Code:
Sub PhaseReminder()    Dim appOL As Object
    Dim objReminder As Object
     
    Sheets("MBC").Select
    
    Set appOL = GetObject(, "Outlook.application")
    Set objReminder = appOL.CreateItem(1) ' olAppointmentItem
    'Set objReminder = objOA.CreateItem(olTaskItem)  'Creates a task item
         
    objReminder.Start = Range("D61") ' 4/Feb/2004 18:30
    objReminder.Duration = Range("F61") ' 30
    objReminder.Subject = Range("B61") ' subject text
    objReminder.Location = Range("G61") ' Location of the project
    objReminder.BusyStatus = olFree ' Sets your calander to show that you are Free and not Busy
    
    objReminder.Body = "Date/time created:   " & Format(Date, "mm-dd-yy") & "   " & Time & vbNewLine & vbNewLine & _
    Range("A100") & vbNewLine & vbNewLine & _
    "PROJECT INFORMATION (This information was created at the time the phasing reminder was executed and may not be up-to-date!):" & vbNewLine & _
    Range("D12") & vbNewLine & Range("D13") & vbNewLine & Range("D14") & vbNewLine & Range("D15") & vbNewLine & vbNewLine & _
    Range("D16") & vbNewLine & Range("D17") & vbNewLine & vbNewLine & _
    Range("D18") & vbNewLine & Range("D19") & vbNewLine & Range("D20") & vbNewLine & Range("D21") & vbNewLine & Range("D22") & vbNewLine & _
    Range("D23") & vbNewLine & Range("D24") & vbNewLine & Range("D25") & vbNewLine & Range("D26") & vbNewLine & Range("D27") & vbNewLine & _
    Range("D28") & vbNewLine & Range("D29") & vbNewLine & Range("D30") & vbNewLine & Range("D31") & vbNewLine & Range("D32") & vbNewLine & _
    Range("D33") & vbNewLine & Range("D34") & vbNewLine & Range("D35") & vbNewLine & Range("A5")
    
    
    'objReminder.Categories = "Acc - 1st Report"
    'objReminder.Subject = "Equipment: " & colControls("txtFullName").Value & " " & colControls("txtDateReception").Value
    'objReminder.To = Range("H61")
    'objReminder.StartDate = DateAdd("n", 1, Now)
    'objReminder.DueDate = DateAdd("n", 3, Now)
    'objReminder.ReminderTime = DateAdd("n", 1, Now)


    
    objReminder.ReminderSet = True
    objReminder.Save
    
    Sheets("Options").Select
    
End Sub

As you can see the meat of my information is in the 61 row. I am trying to get this to do 9 other rows.




Hopefully this will shed some light:


PhaseDescriptionManpowerStartEnd
Date
1Phase 124/12/20147:00:00 AM4/16/20143:30:00 PM
2
3
4
5
6
7
8
9
10

<tbody>
</tbody>


Thanks.
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Try this:

Code:
Option Explicit

Sub PhaseReminder()

    Dim appOL As Object
    Dim objReminder As Object
    Dim lX As Long
    Dim lLastDataRow As Long
     
    Sheets("MBC").Select
    
    lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Assuming the list of reminders you want to set are at the bottom of MBC starting in column A
    
    Set appOL = GetObject(, "Outlook.application")
    
    For lX = 61 To lLastDataRow
    
        Set objReminder = appOL.CreateItem(1) ' olAppointmentItem
        'Set objReminder = objOA.CreateItem(olTaskItem)  'Creates a task item
             
        objReminder.Start = Range("D" & lX) ' 4/Feb/2004 18:30
        objReminder.Duration = Range("F" & lX) ' 30
        objReminder.Subject = Range("B" & lX) ' subject text
        objReminder.Location = Range("G" & lX) ' Location of the project
        objReminder.BusyStatus = 0 'olFree ' Sets your calander to show that you are Free and not Busy
        
        objReminder.Body = "Date/time created:   " & Format(Date, "mm-dd-yy") & "   " & Time & vbCrLf & vbCrLf & _
            Range("A100") & vbCrLf & vbCrLf & _
            "PROJECT INFORMATION (This information was created at the time the phasing reminder was executed and may not be up-to-date!):" & vbCrLf & _
            Range("D12") & vbCrLf & Range("D13") & vbCrLf & Range("D14") & vbCrLf & Range("D15") & vbCrLf & vbCrLf & _
            Range("D16") & vbCrLf & Range("D17") & vbCrLf & vbCrLf & _
            Range("D18") & vbCrLf & Range("D19") & vbCrLf & Range("D20") & vbCrLf & Range("D21") & vbCrLf & Range("D22") & vbCrLf & _
            Range("D23") & vbCrLf & Range("D24") & vbCrLf & Range("D25") & vbCrLf & Range("D26") & vbCrLf & Range("D27") & vbCrLf & _
            Range("D28") & vbCrLf & Range("D29") & vbCrLf & Range("D30") & vbCrLf & Range("D31") & vbCrLf & Range("D32") & vbCrLf & _
            Range("D33") & vbCrLf & Range("D34") & vbCrLf & Range("D35") & vbCrLf & Range("A5")
        
        'objReminder.Categories = "Acc - 1st Report"
        'objReminder.Subject = "Equipment: " & colControls("txtFullName").Value & " " & colControls("txtDateReception").Value
        'objReminder.To = Range("H61")
        'objReminder.StartDate = DateAdd("n", 1, Now)
        'objReminder.DueDate = DateAdd("n", 3, Now)
        'objReminder.ReminderTime = DateAdd("n", 1, Now)
    
        objReminder.ReminderSet = True
        objReminder.Save
        
    Next
    
    Sheets("Options").Select
    
End Sub

vbCrLf is the same as vbNewLine and takes less space
 
Upvote 0
Phil-

Thank you for your response. I am new to VBA, but I catch on pretty quick with the right push, so hang with me for a sec.

Here's what I am seeing:
Code:
Option Explicit


Sub PhaseReminder()


    Dim appOL As Object
    Dim objReminder As Object
    Dim lX As Long
    Dim lLastDataRow As Long
     
    Sheets("MBC").Select
    
    lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'I am getting a "Compile error: invalid or unqualified reference" and it specifically highlights ".Rows",  I am also not understanding what this line actually does
    
    Set appOL = GetObject(, "Outlook.application")
    
    For lX = 61 To lLastDataRow 'Defines the length, in rows, of how far this code should run
    
        Set objReminder = appOL.CreateItem(1)
             
        objReminder.Start = Range("D" & lX)
        objReminder.Duration = Range("F" & lX)
        objReminder.Subject = Range("B" & lX)
        objReminder.Location = Range("G" & lX)
        objReminder.BusyStatus = 0
        
        objReminder.Body = "Date/time created:   " & Format(Date, "mm-dd-yy") & "   " & Time & vbCrLf & vbCrLf & _
            Range("A100") & vbCrLf & vbCrLf & _
            "PROJECT INFORMATION (This information was created at the time the phasing reminder was executed and may not be up-to-date!):" & vbCrLf & _
            Range("D12") & vbCrLf & Range("D13") & vbCrLf & Range("D14") & vbCrLf & Range("D15") & vbCrLf & vbCrLf & _
            Range("D16") & vbCrLf & Range("D17") & vbCrLf & vbCrLf & _
            Range("D18") & vbCrLf & Range("D19") & vbCrLf & Range("D20") & vbCrLf & Range("D21") & vbCrLf & Range("D22") & vbCrLf & _
            Range("D23") & vbCrLf & Range("D24") & vbCrLf & Range("D25") & vbCrLf & Range("D26") & vbCrLf & Range("D27") & vbCrLf & _
            Range("D28") & vbCrLf & Range("D29") & vbCrLf & Range("D30") & vbCrLf & Range("D31") & vbCrLf & Range("D32") & vbCrLf & _
            Range("D33") & vbCrLf & Range("D34") & vbCrLf & Range("D35") & vbCrLf & Range("A5")
        
        objReminder.ReminderSet = True
        objReminder.Save
        
    Next 'Starts the process above over until it reaches the end of what 1LastDataRow is defined as
    
    Sheets("Options").Select
    
End Sub
 
Upvote 0
This line is not working:
Code:
[COLOR=#333333]lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'I am getting a "Compile error: invalid or unqualified reference" and it specifically highlights ".Rows",  I am also not understanding what this line actually does.[/COLOR]

But I Googled ".Cells(.Rows.Count, 1).End(xlUp).Row" and found that I needed to put "With ActiveSheet" before this line. I don't know what "With" does but it worked.

With respect to your note: "Assuming the list of reminders you want to set are at the bottom of MBC starting in column A". I understand this now. This code will go to the end of the column and return the last row used in that column. In my case I am using data below this specific set of data so this code is running to from B61 all the way down to B184 (verified with a MsgBox). I need to tighten it up to B61 to B70. I tried a few IF statements but failed.
 
Upvote 0
This code at the end will process contiguous rows from A61 down, but not farther than row A70.

This paragraph:
Code:
    With Sheets("MBC")
        .Select
        lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

is functionally the same as this one:
Code:
    Sheets("MBC").Select
    lLastDataRow = Sheets("MBC").Cells(Sheets("MBC").Rows.Count, 1).End(xlUp).Row

The With / End with block allows you to use shortcuts to reference the object after the With. In this case, anything that starts with a period is treated as if Sheets("MBC") was in front of the period. It can save a lot of typing in many cases, but was not really needed in this one.

Code:
Option Explicit

Sub PhaseReminder()

    Dim appOL As Object
    Dim objReminder As Object
    Dim lX As Long
    Dim lLastDataRow As Long
     
    Sheets("MBC").Select
    

    lLastDataRow = Sheets("MBC").Cells(61, 1).End(xlDown).Row 'Assuming the list of reminders you want to set start at row 61 and are contiguous below it
    If lLastDataRow > 70 Then lLastDataRow = 70  'and that the last row to be processed is row 70 or above
    
    Set appOL = GetObject(, "Outlook.application")
    
    For lX = 61 To 70
    
        Set objReminder = appOL.CreateItem(1) ' olAppointmentItem
        'Set objReminder = objOA.CreateItem(olTaskItem)  'Creates a task item
             
        objReminder.Start = Range("D" & lX) ' 4/Feb/2004 18:30
        objReminder.Duration = Range("F" & lX) ' 30
        objReminder.Subject = Range("B" & lX) ' subject text
        objReminder.Location = Range("G" & lX) ' Location of the project
        objReminder.BusyStatus = 0 'olFree ' Sets your calander to show that you are Free and not Busy
        
        objReminder.Body = "Date/time created:   " & Format(Date, "mm-dd-yy") & "   " & Time & vbCrLf & vbCrLf & _
            Range("A100") & vbCrLf & vbCrLf & _
            "PROJECT INFORMATION (This information was created at the time the phasing reminder was executed and may not be up-to-date!):" & vbCrLf & _
            Range("D12") & vbCrLf & Range("D13") & vbCrLf & Range("D14") & vbCrLf & Range("D15") & vbCrLf & vbCrLf & _
            Range("D16") & vbCrLf & Range("D17") & vbCrLf & vbCrLf & _
            Range("D18") & vbCrLf & Range("D19") & vbCrLf & Range("D20") & vbCrLf & Range("D21") & vbCrLf & Range("D22") & vbCrLf & _
            Range("D23") & vbCrLf & Range("D24") & vbCrLf & Range("D25") & vbCrLf & Range("D26") & vbCrLf & Range("D27") & vbCrLf & _
            Range("D28") & vbCrLf & Range("D29") & vbCrLf & Range("D30") & vbCrLf & Range("D31") & vbCrLf & Range("D32") & vbCrLf & _
            Range("D33") & vbCrLf & Range("D34") & vbCrLf & Range("D35") & vbCrLf & Range("A5")
        
        'objReminder.Categories = "Acc - 1st Report"
        'objReminder.Subject = "Equipment: " & colControls("txtFullName").Value & " " & colControls("txtDateReception").Value
        'objReminder.To = Range("H61")
        'objReminder.StartDate = DateAdd("n", 1, Now)
        'objReminder.DueDate = DateAdd("n", 3, Now)
        'objReminder.ReminderTime = DateAdd("n", 1, Now)
    
        objReminder.ReminderSet = True
        objReminder.Save
        
    Next
    
    Sheets("Options").Select
    
End Sub
 
Upvote 0
Phil-
I got this working. I think it had something to do with the cells having an equation in them that made the code run longer that it should because it was tricked into thinking there was usable data there. I created an extra hidden cell to count how many cells had usable data, with some addition and subtraction, and return the last row used. I then called it an integer and named it LastUsed. The rest is below. Thank you for your help. I've learned quite a bit the last few weeks about VBA from people like you on this board. Thanks again.

Code:
Option Explicit

Sub PhaseReminder()


Dim appOL As Object
Dim objReminder As Object
Dim lX As Long
Dim LastUsed As Integer


Sheets("MBC").Select


LastUsed = Sheets("MBC").Range("B59")
Set appOL = GetObject(, "Outlook.application")


For lX = 61 To LastUsed


Set objReminder = appOL.CreateItem(1)




With objReminder
    .Start = Range("D" & lX)
    .Duration = Range("F" & lX)
    .Subject = Range("B" & lX)
    .Location = Range("G" & lX)
    .BusyStatus = 0
    .Body = "Date/time created: " & Format(Date, "mm-dd-yy") & " " & Time & vbCrLf & vbCrLf & _
             Range("A100") & vbCrLf & vbCrLf & _
             "PROJECT INFORMATION (This information was created at the time the phasing reminder was executed and may not be up-to-date!):" & vbCrLf & _
             Range("D12") & vbCrLf & Range("D13") & vbCrLf & Range("D14") & vbCrLf & Range("D15") & vbCrLf & vbCrLf & _
             Range("D16") & vbCrLf & Range("D17") & vbCrLf & vbCrLf & _
             Range("D18") & vbCrLf & Range("D19") & vbCrLf & Range("D20") & vbCrLf & Range("D21") & vbCrLf & Range("D22") & vbCrLf & _
             Range("D23") & vbCrLf & Range("D24") & vbCrLf & Range("D25") & vbCrLf & Range("D26") & vbCrLf & Range("D27") & vbCrLf & _
             Range("D28") & vbCrLf & Range("D29") & vbCrLf & Range("D30") & vbCrLf & Range("D31") & vbCrLf & Range("D32") & vbCrLf & _
             Range("D33") & vbCrLf & Range("D34") & vbCrLf & Range("D35") & vbCrLf & Range("A5")
    .ReminderSet = True
    .Save
End With


'Set objReminder = objOA.CreateItem(olTaskItem) 'Creates a task item
'objReminder.Categories = "Acc - 1st Report"
'objReminder.Subject = "Equipment: " & colControls("txtFullName").Value & " " & colControls("txtDateReception").Value
'objReminder.To = Range("H61")
'objReminder.StartDate = DateAdd("n", 1, Now)
'objReminder.DueDate = DateAdd("n", 3, Now)
'objReminder.ReminderTime = DateAdd("n", 1, Now)


Next


Sheets("Options").Select


End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,978
Messages
6,122,549
Members
449,089
Latest member
davidcom

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top