Совет: Други јазици се Google-преведени. Можете да ја посетите English верзија на оваа врска.
Логирај Се
x
or
x
x
Регистрирај се
x

or

Како да креирате потсетници Outlook од табела на Excel?

Оваа статија зборува за креирање потсетници на Outlook врз основа на податоци од Excel табела.

Крити Outlook потсетници од Excel табела со VBA код

Kutools за Outlook: 100 + нови напредни алатки за Outlook.
Канцеларија јазиче: Овозможи уредување на јазичиња и прелистување во Office, Само како Хром, Firefox, IE 8 / 9 / 10.
Класично мени: Ставете ги старите менија и алатници назад до Office 2007, 2010, 2013, 2016 и 2019.

Крити Outlook потсетници од Excel табела со VBA код

Ако сакате да креирате Outlook потсетници од Excel, ве молиме да го направите следново.

1. Креирање на лист содржи заглавија на колоните и соодветните полиња за потсетување како што е прикажано подолу.

Забелешка: За зафатен статус колона, број 2 значи дека потсетникот ќе биде прикажан како Зафатен во вашиот Outlook календар. Можете да го промените 1 (пробен), 3 (надвор од канцеларија), 4 (Работење на друго место)или 5 (слободен) како што ви треба.

2. Притиснете го копчето Alt + F11 клучеви за отворање на Microsoft Visual Basic за апликации прозорец.

3. Во Microsoft Visual Basic за апликации прозорецот, кликнете на Вметнете > Модули. Потоа копирајте го кодот подолу VBA во прозорецот Code.

VBA код: Креирајте потсетници на Outlook од табела со Excel

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

Забелешка: Во горниот код, A2: G2 е опсегот на податоци за кој сакате да креирате состаноци врз основа на.

4. Притиснете го копчето F5 клуч или кликнете на копчето Run за да го извршите кодот. Тогаш сите состаноци со специфични полиња ќе бидат внесени во календарот на Outlook одеднаш.

И потоа, можете да одите во Календарот на вашиот изглед за да ги видите резултатите, видете го екранот:



Kutools за Outlook

Повеќе од 100 Напредни функции за Outlook 2010, 2013, 2016, 2019 и 365

екран застрелан kutools за изгледите мал за банер 201812

Повеќе функции | Free Download | Само $ 39.00 за стотици функции

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Keith · 2 days ago
    Hello, the code seems very helpful but has one drawback, If the file is updated continuously it will create a new reminder each time it is run. Can a line be added to delete all previous reminders and then create new ones?
    Also can this be exported to multiple outlook accounts?
  • To post as a guest, your comment is unpublished.
    Alexandra · 2 months ago
    Hello! Love the idea of this code, but I have a few questions:


    1. It won't run because of the "bug" on this line (error 440, Run time error):
    xOutItem.ReminderMinutesBeforeStart = xRg.Cells(I, 6).Value
    2. If I don't necessarily want to put the column headers from A2:G2, can i just simply change it in the code (ex: F3-K3), will it still work?
    3. How does it know to connect to my outlook?


    Thank you for your response, I'd really appreciate it!
    • To post as a guest, your comment is unpublished.
      crystal · 1 months ago
      Hi Alexandra,
      The 440 error didn't occur in my case. Which Office version do you use?
      The code won't work if you simply change the code to F3:K3. If you need the answer, i will try to figure it out.
      This line "Set xOutApp = CreateObject("Outlook.Application")" will help to connect the Excel data to the Outlook application.
      Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Michelle · 2 months ago
    Hello, thank you for the code but I'm struggling with it only putting in the first entry in excel into Outlook. How do i get it to enter in all line items?
    Here is my code, I added in a category color


    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) + xRg.Cells(I, 8).Value
    xOutItem.Duration = xRg.Cells(I, 4).Value
    xOutItem.Categories = xRg.Cells(I, 9).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
    • To post as a guest, your comment is unpublished.
      Dennis Briggs · 18 days ago
      I'm having the same issue, the code works great but is only adding the first appointment to the calendar. Here is my code:
      <code>
      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
      </code>
    • To post as a guest, your comment is unpublished.
      crystal · 1 months ago
      Hi Michelle,
      I don't understand your question. Would be nice if you could provide screenshot of what you are trying to do. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Riaz · 5 months ago
    Hi There,

    Great formula/code.


    What happens that this code generates multiple entries in the outlook calendar if its run more than once by mistake. I also wanted it to be setup as a template so that staff can use it. They can put in the dates and rest of the details are required and when they run it should list the entries in outlook calendar. Any deleted excel data should be deleted from outlook as well and same applies to any changes. When I save the excel spreadsheet it saves in the default excel format, but I want it to be saved with Macros so that it does not lose the code and staff can use it as many times as needed. Can you please advise and make relevant changes to the code? Thanks
    • To post as a guest, your comment is unpublished.
      crystal · 4 months ago
      Hi,
      For saving the macros for future use in the Workbook, you need to click File > Save As > Browse > select a folder to save the workbook > choose “Excel Macro-enabled Workbook” from the Save as type drop-down > Save.