VBA Script Help to Outlook

K

kav

New Member
Joined
Sep 16, 2007
Messages
10
I have a script which I am using to link to Outlook calendar which works fine. I need to modify the script to copy a range of cells (“D10:D18”) to the body of the outlook appointment but can seem to get this to work can any one help?

Thanks

Sub OutLook_Calendar()

Dim olApp As Object
'Dim olApp As Outlook.Application
Dim olApt As Object
Dim olNs As Object

' The following routine displays the calendar, opening OL if needed
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")

If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.application")
End If

On Error GoTo 0

Set olNs = olApp.GetNamespace("MAPI")

If olApp.ActiveExplorer Is Nothing Then
olApp.Explorers.Add _
(olNs.GetDefaultFolder(9), 0).Activate
Else
Set olApp.ActiveExplorer.CurrentFolder = _
olNs.GetDefaultFolder(9)
olApp.ActiveExplorer.Display
End If

' Set olApp = New Outlook.Application
Set olApt = olApp.CreateItem(olAppointmentItem)
' Gather the values to use in the appointment
usedate = Range("date_default").Value
usesubject = Range("subject").Value


With olApt
.Start = usedate + TimeValue("9:00:00")
.End = usedate + TimeValue("11:00:00")
.Subject = usesubject
.Location = usesubject & " location"
.Body = ???????????????????????????????????????????????????
.BusyStatus = olOutOfOffice
.ReminderMinutesBeforeStart = 30
.ReminderSet = True
.Save
End With

olApt.Display

Set olApt = Nothing
Set olApp = Nothing
Set olNs = Nothing

End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
I'm no expert on this sort of thing but I'd guess you will need to force the range into one string, something like the below perhaps ?

Code: 
Sub OutLook_Calendar()
Dim olApp As Object
Dim olApt As Object
Dim olNs As Object
Dim body_rng As Range: Set body_rng = Range("D1:D10")
Dim cell As Range
Dim usedate As Date
Dim usesubject As String
Dim usebody As String
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
    Set olApp = CreateObject("Outlook.application")
End If
On Error GoTo 0
Set olNs = olApp.GetNamespace("MAPI")
If olApp.ActiveExplorer Is Nothing Then
    olApp.Explorers.Add(olNs.GetDefaultFolder(9), 0).Activate
Else
    Set olApp.ActiveExplorer.CurrentFolder = olNs.GetDefaultFolder(9)
    olApp.ActiveExplorer.Display
End If
Set olApt = olApp.CreateItem(olAppointmentItem)
usedate = CDate(Range("date_default").Value)
usesubject = Range("subject").Value
For Each cell In body_rng
    usebody = usebody & cell.Value & vbCrLf
Next cell
With olApt
    .Start = usedate + TimeSerial(9, 0, 0)
    .End = usedate + TimeSerial(11, 0, 0)
    .Subject = usesubject
    .Location = usesubject & " location"
    .Body = usebody
    .BusyStatus = olOutOfOffice
    .ReminderMinutesBeforeStart = 30
    .ReminderSet = True
    .Save
End With
olApt.Display
Set olApt = Nothing
Set olApp = Nothing
Set olNs = Nothing
End Sub
 
Upvote 0
Re: http://www.mrexcel.com/forum/showthread.php?t=352069

When I posted the original reply the code worked for me without incident however I didn't specify a worksheet for the body_rng which was short-sighted of me.

If you change this line:

Rich (BB code): 
Dim body_rng As Range: Set body_rng = Range("D1:D10")

To

Rich (BB code): 
Dim body_rng As Range: Set body_rng = Sheets("SheetName").Range("D1:D10")

Alterting the text in red to be the name of the sheet on which the Body Range resides does it work for you then ?

If not can you clarify exactly what data types are in the range etc so I can try to replicate exactly -- ie dates / text etc...

As for the dupe post - it's not a question of stress but given we're all here for free and on our own time we prefer to not spend time trying to answer a question that may (or may not as in this case) have been answered satisfactorily for the OP in another thread somewhere else ;)

Cheers
 
Upvote 0
Hi Donkeyote

I replaced the line and it worked a treat!

Thanks for your help and advice

Kav
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
Macro to Generate Reminder in Outlook Calendar
Replies
3
Views
1K
Micron
M
L
  • Question
VBA query - not opening outlook email but one drive
Replies
0
Views
213
Liverlee
L
N
  • Question
2 QUESTIONS - DATE SEARCH AND OUTLOOK CALENDER
Replies
0
Views
258
nick_rubingh
N
B
  • Question
Excel to Outlook Calendar as Appointments - Delete Duplicate Entries
Replies
0
Views
652
Bwiles96
B
Georgiboy
  • Solved
Intermittent error Excel - Outlook VBA
2
Replies
14
Views
655
Georgiboy
Georgiboy

Forum statistics

Threads
1,216,179
Messages
6,129,338
Members
449,504
Latest member
Alan the procrastinator

Share this page

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