makroda eklenti

[omurdeep]

merhabalar,

aşağıdaki makroya şunu eklemeye çalışıyorum ama vbir türlü yazamıyorum. "OK" yazan kısımları kontrol etsin olmayanları takvime eklesin olanları es geçsin.

ilgili dosyada ektedir.


Dim oOutLook As Object
Dim oRandevu As Object

For g = 6 To Cells(Rows.Count, "B").End(3).Row


On Error Resume Next
Set oOutLook = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set oOutLook = CreateObject("Outlook.application")
End If
On Error GoTo 0

Set oRandevu = oOutLook.CreateItem(olAppointmentItem)

On Error Resume Next

For i = 1 To Cells(501, 3).End(xlUp).Row
If Cells(i, 2) = " " Then

With oRandevu
.Start = Cells(i, 3) + Cells(i, 4)
.End = Cells(i, 5) + Cells(i, 6)
.Subject = Cells(i, 7)
.Location = Cells(i, 9)
.Body = Cells(i, 8).Value
.Categories = Cells(i, 10)
.RequiredAttendees = Cells(i, 13) 'zorunlu katılımcı
'.OptionalAttendees = "eee.fff@mail.com;ggg.hhh@mail.com" 'opsiyonel katılımcı
.Display 'görüntülemek için
'.Send 'göndermek için

If Err <> 0 Then
Cells(i, 2) = "HATA"
Else
.Save
Cells(i, 2) = "OK"
Err = 0

End If

End With



End If

' oRandevu.Display

Set oOutLook = Nothing
Set oRandevu = Nothing
Next i

End Sub