როგორ გავაერთიანოთ ყველა დანიშვნა და შეხვედრა ყველა კალენდრიდან Outlook VBA-ით

Outlook Solutions სექტემბერი 29, 2025

თუ გსურთ, რომ ყოველთვის გააერთიანოთ ყველა კალენდრიდან ყველა შეხვედრა და შეხვედრა ერთ კალენდარში მოსახერხებელი შემოწმებისთვის, შეგიძლიათ გამოიყენოთ ამ სტატიაში დანერგილი მეთოდი.

შესაძლოა, თქვენ გაქვთ ბევრი ელ.ფოსტის ანგარიში კონფიგურირებული თქვენს Outlook-ში. ამ შემთხვევაში, თქვენ უნდა გქონდეთ ბევრი კალენდარი თქვენს Outlook-ში. ამიტომ, ყოველ ჯერზე, როდესაც გსურთ შეამოწმოთ რამდენი შეხვედრაა დღეს, თქვენ უნდა გადახვიდეთ ყველა კალენდარზე. ცოტა პრობლემური იქნება. მაშ, რატომ არ აერთიანებთ მათ ერთ კალენდარში? შემდეგში ჩვენ გამოვავლენთ VBA კოდის ნაწილს, რომელსაც შეუძლია მისი მარტივად რეალიზება.

ავტომატური შერწყმა ყველა დანიშვნა და შეხვედრა ყველა კალენდარიდან

თავიდანვე გაუშვით თქვენი Outlook აპლიკაცია.
Outlook-ის მთავარ ფანჯარაში შესვლის შემდეგ დააჭირეთ ღილაკს "Alt + F11".
შემდეგ თქვენ მოხვდებით "Microsoft Visual Basic აპლიკაციებისთვის" ფანჯარაში.
შემდეგ თქვენ უნდა იპოვოთ და გახსნათ პროექტი "ThisOutlookSession".
შემდგომში, თქვენ უნდა დააკოპიროთ და ჩასვათ შემდეგი VBA კოდები ამ პროექტის ფანჯარაში.

'Here we take two calendars as an example - "Calendar A" & "Calendar B"
'You can add more as per your needs
Dim WithEvents objACalendarItems As Outlook.Items
Dim WithEvents objBCalendarItems As Outlook.Items
Dim objDefaultCalendar As Outlook.Folder
 
Private Sub Application_Startup()
    Set objACalendarItems = Application.Session.folders("File A").folders("Calendar").Items
    Set objBCalendarItems = Application.Session.folders("File B").folders("Calendar").Items

    'Here we merge into the default calendar
    Set objDefaultCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
End Sub
 
Private Sub objACalendarItems_ItemAdd(ByVal Item As Object)
    Call CopyToDefaultCalendar(Item)
End Sub

Private Sub objBCalendarItems_ItemAdd(ByVal Item As Object)
    Call CopyToDefaultCalendar(Item)
End Sub

Private Sub CopyToDefaultCalendar(ByVal objItem As Object)
    Dim objCopiedAppointment As Outlook.AppointmentItem
    Dim objMoviedAppointment As Outlook.AppointmentItem
    Dim strPSTFileName As String
 
    Set objCopiedAppointment = objItem.Copy
    Set objMoviedAppointment = objCopiedAppointment.Move(objDefaultCalendar)
 
    strPSTFileName = objItem.parent.parent.Name
 
    'Tag the source of the copied appointments
    objMoviedAppointment.Categories = "From " & strPSTFileName
    objMoviedAppointment.Save
    'If want to delete it from the original calendar, add the following line:
    'objItem.Delete
End Sub

ამის შემდეგ, თქვენ უნდა მიანიჭოთ ციფრული სერთიფიკატი მიმდინარე მაკროს.
მოგვიანებით გადადით „მაკრო პარამეტრებზე“ ციფრულად ხელმოწერილი მაკროების დასაშვებად.
საბოლოოდ, შეგიძლიათ გადატვირთოთ Outlook პროგრამა ახალი მაკროს გასააქტიურებლად.
ამიერიდან, ყოველ ჯერზე, როდესაც რაიმე ახალი შეხვედრა ან შეხვედრა დაემატება არანაგულისხმევ კალენდრებში, ის ავტომატურად დაკოპირდება ნაგულისხმევ კალენდარში, როგორიცაა შემდეგი ეკრანის სურათი:

დროულად წაშალეთ ვადაგადაცილებული ნივთები კალენდარიდან

როგორც ვიცით, Outlook უფრო მიდრეკილია სხვადასხვა შეცდომისკენ, როდესაც საფოსტო ყუთი უფრო და უფრო დიდი ხდება. ამიტომ, რეკომენდებულია საფოსტო ყუთიდან დროულად ამოიღოთ უსარგებლო ნივთები, როგორიცაა ვადაგადაცილებული პაემნები და შეხვედრები. იმავდროულად, სჯობს იქვე შეინახოთ ძლიერი სარემონტო ხელსაწყო, მაგალითად DataNumen Outlook Repair. Მას შეუძლია Outlook-ის შეკეთება პრობლემები ოფლის გატეხვის გარეშე.

ავტორი შესავალი:

შირლი ჟანგი არის მონაცემთა აღდგენის ექსპერტი DataNumen, Inc., რომელიც მსოფლიო ლიდერია მონაცემთა აღდგენის ტექნოლოგიებში, მათ შორის sql აღდგენა და Outlook სარემონტო პროგრამული პროდუქტები. დამატებითი ინფორმაციისთვის ეწვიეთ www.datanumen. ერთად