Excel elektronik tablosundan Outlook hatırlatıcıları nasıl oluşturulur?

Bu makale, Excel elektronik tablosundaki verilere dayanarak Outlook hatırlatıcılarının nasıl oluşturulacağını anlatmaktadır.

Excel elektronik tablosundan VBA kodu ile Outlook hatırlatıcıları oluşturun

---

Excel elektronik tablosundan VBA kodu ile Outlook hatırlatıcıları oluşturun

Excel'den Outlook hatırlatıcıları oluşturmak istiyorsanız, lütfen aşağıdaki adımları takip edin.

1. Aşağıdaki ekran görüntüsünde gösterildiği gibi, sütun başlıkları ve ilgili hatırlatma alanlarını içeren bir çalışma sayfası oluşturun.

Not: “Meşguliyet durumu” sütunu için “2” sayısı, hatırlatıcının Outlook takviminizde “Meşgul” olarak görüntüleneceğini gösterir. Gerekirse bunu “1 (Geçici)”, “3 (Ofis dışındayım)”, “4 (Başka Bir Yerde Çalışıyor)” veya “5 (Boş)” olarak değiştirebilirsiniz.

2. "Microsoft Visual Basic for Applications" penceresini açmak için "Alt" + "F11" tuşlarına basın.

3. "Microsoft Visual Basic for Applications" penceresinde **Ekle > Modül** seçeneğine tıklayıp aşağıdaki VBA kodunu Kod penceresine kopyalayın.

VBA kodu: Excel elektronik tablosundan Outlook hatırlatıcıları oluşturun

Sub AddAppointments()
'Update by Extendoffice 20180608
    Dim I As Long
    Dim xRg As Range
    Dim xOutApp As Object
    Dim xOutItem As Object
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = Range("A2:G2")
    For I = 1 To xRg.Rows.Count
        Set xOutItem = xOutApp.CreateItem(1)
        Debug.Print xRg.Cells(I, 1).Value
        xOutItem.Subject = xRg.Cells(I, 1).Value
        xOutItem.Location = xRg.Cells(I, 2).Value
        xOutItem.Start = xRg.Cells(I, 3).Value
        xOutItem.Duration = xRg.Cells(I, 4).Value
        If Trim(xRg.Cells(I, 5).Value) = "" Then
            xOutItem.BusyStatus = 2
        Else
            xOutItem.BusyStatus = xRg.Cells(I, 5).Value
        End If
        If xRg.Cells(I, 6).Value > 0 Then
            xOutItem.ReminderSet = True
            xOutItem.ReminderMinutesBeforeStart = xRg.Cells(I, 6).Value
        Else
            xOutItem.ReminderSet = False
        End If
        xOutItem.Body = xRg.Cells(I, 7).Value
        xOutItem.Save
        Set xOutItem = Nothing
    Next
    Set xOutApp = Nothing
End Sub

Not: Yukarıdaki kodda "A2:G2", randevularınızı oluşturmak istediğiniz veri aralığıdır.

4. Kodu çalıştırmak için "F5" tuşuna basın veya "Çalıştır" düğmesine tıklayın. Ardından, belirtilen alanlara sahip tüm randevular anında Outlook takviminize eklenecektir.

Sonuçları görüntülemek için Outlook’unuzun Takvim bölümüne gidin. Ekran görüntüsüne göz atın: