I'm trying to create a Macro to create Outlook appointments based on words in Column B. For some reason, my code to create appointments is creating each item in the subfolder twice.
Also, I'm trying to get the appointment date to be column F -30 days.
I tried <code style="margin: 0px; padding: 1px 5px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; font-size: 13px; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; background-color: rgb(239, 240, 241); white-space: pre-wrap;">oAppt.Start = cell(0, 6).value -30.
</code>My code right now is below.
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">
Sub CreateAppointment()
Dim ws As Worksheet
Dim subfolders()AsString
Dim cell As Range, i AsInteger
Dim oAppt As AppointmentItem
subfolders = Split("UGD GAS,FOUNDATION REDESIGN",",")
Application.ScreenUpdating =False
ForEach ws In ActiveWorkbook.Worksheets
ForEach cell In ws.Range("B1:B100")
For i = LBound(subfolders)To UBound(subfolders)
If cell.Value = subfolders(i)Then
Set oAppt = Outlook.Application.CreateItem(olAppointmentItem)
oAppt.Subject = cell.Value
oAppt.Start =Date-30
oAppt.Save
EndIf
Next i
Next cell
Next
Application.ScreenUpdating = True
End Sub
</code>Link to sample of my spreadsheet data
https://drive.google.com/open?id=1o74ZFwL4IbXt_U45dRp38Kj_DTFqp3B7
Any help would be much appreciated!
Also, I'm trying to get the appointment date to be column F -30 days.
I tried <code style="margin: 0px; padding: 1px 5px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; font-size: 13px; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; background-color: rgb(239, 240, 241); white-space: pre-wrap;">oAppt.Start = cell(0, 6).value -30.
</code>My code right now is below.
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">
Sub CreateAppointment()
Dim ws As Worksheet
Dim subfolders()AsString
Dim cell As Range, i AsInteger
Dim oAppt As AppointmentItem
subfolders = Split("UGD GAS,FOUNDATION REDESIGN",",")
Application.ScreenUpdating =False
ForEach ws In ActiveWorkbook.Worksheets
ForEach cell In ws.Range("B1:B100")
For i = LBound(subfolders)To UBound(subfolders)
If cell.Value = subfolders(i)Then
Set oAppt = Outlook.Application.CreateItem(olAppointmentItem)
oAppt.Subject = cell.Value
oAppt.Start =Date-30
oAppt.Save
EndIf
Next i
Next cell
Next
Application.ScreenUpdating = True
End Sub
</code>Link to sample of my spreadsheet data
https://drive.google.com/open?id=1o74ZFwL4IbXt_U45dRp38Kj_DTFqp3B7
Any help would be much appreciated!