help with macro to create outlook events from excel data

[zoog25]

Hello all,

Currently I have been tasked with trying to develop a link between an excel spreadsheet and outlook. What they want is for a button to pickup new entries into the sheet and then create outlook events based on several criteria. The first been that is put on several shared calendars, second that the category of the event is call "BID" and gold in color. The last part is where specific information from the spreadsheet fits into the event areas (ie. subject, location, start time, body). I did find code that is a possible solution but i need help manipulating it to what i need. Here is the code.

Option Explicit


Sub AddToOutlook()


Dim OL As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim NS As Outlook.Namespace
Dim colItems As Outlook.Items
Dim olApptSearch As Outlook.AppointmentItem
Dim r As Long, sSubject As String, sBody As String
Dim dStartTime As Date, dEndTime As Date
Dim sSearch As String, bOLOpen As Boolean


On Error Resume Next
Set OL = GetObject(, "Outlook.Application")
bOLOpen = True


If OL Is Nothing Then
    Set OL = CreateObject("Outlook.Application")
        bOLOpen = False
End If


Set NS = OL.GetNamespace("MAPI")
Set colItems = NS.GetDefaultFolder(olFolderCalendar).Items




sSubject = Range("A" & r).Value & " " & ":" & " " & Range("F" & r).Value
sBody = *Copy active row and paste in body*
If Range("D" & r).Value = "" then 
    dStartTime = Range("C" & r).Value & 5:00 pm
    dEndTime = Range ("C" & r).Value & 5.00 pm
Else
    dStartTime = Range("C" & r).value & " " & Range("D" & r).Value
    dEndTime = Range ("C" & r).Value & " " & Range ("D" & r).Value
End if 


sSearch = "[Subject] = " & sQuote(sSubject)
Set olApptSearch = colItems.Find(sSearch)


If olApptSearch Is Nothing Then
    Set olAppt = OL.CreateItem(olAppointmentItem)
           olAppt.Body = sBody
           olAppt.Subject = sSubject
           olAppt.Start = dStartTime
           olAppt.End = dEndTime
    olAppt.Close olSave
End If


If bOLOpen = False Then OL.Quit


End Sub

As you can see for the most part I have been able to fill in most of the program with what i needed. Now here are the things i need help with. I have column B on the sheet that has r's on it. If there is an r in that column then the macro creates information from that row, else it skips to the next one. so i need a loop. Also like stated above, how do you make it an event and not a meeting, how do you set the category and lastly for the boy how do i set it so it copies the entire row (column A, Column C to Column L)?

Thank you for any help you can give me.

 

[zoog25]

Please help me if anyone can.