Outlook VBA арқылы белгілі бір уақыт ауқымындағы бос емес кездесулердің тізімін қалай басып шығаруға болады

Outlook шешімдері Қыркүйек 29, 2025
Қазір бөлісу:

Бұл мақала сізге «бос емес» ретінде көрсетілген және белгілі бір уақыт аралығында жоспарланған барлық кездесулердің тізімін басып шығарудың қарапайым әдісін үйретеді.

Белгілі бір күндер ауқымындағы барлық бос емес кездесулерді табу үшін барлық күнтізбелерді айналдырып қарау өте оңай. Іздеу ауқымын «Барлық күнтізбе элементтері» күйіне орнатуға болады. Содан кейін, «Уақытты көрсету» «Бос емес» күйіне тең және белгілі бір басталу және аяқталу күндері аралығындағы кездесулерді іздеңіз. Бірақ осылайша, табылған кездесулерді басып шығарғыңыз келгенде және «Файл» > «Басып шығару» бөліміне өткенде, тек «Жазба стилі» қолжетімді екенін көре аласыз. Бұл тізімдегі табылған кездесулерді басып шығара алмайтыныңызды білдіреді. Сондықтан, егер сіз осындай кездесулердің тізімін басып шығарғыңыз келсе, келесі әдісті қолдана аласыз.

Табылған кездесулер үшін тек Memo стилі қол жетімді

Барлық бос кездесулердің тізімін нақты күндер аралығында басып шығарыңыз

  1. Ең басында Outlook VBA редакторын «Alt + F11» арқылы іске қосыңыз.
  2. Содан кейін, «Қолданбаларға арналған Microsoft Visual Basic» қалқымалы терезесінде «MS Excel Object Library» сілтемесін «» сәйкес қосыңыз.VBA бағдарламасында объект кітапханасына сілтемені қалай қосуға болады«.
  3. Осыдан кейін келесі VBA кодын модульге салыңыз.
Dim dStart, dEnd As Date
Dim objExcelApp As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelWorksheet As Excel.Worksheet

Sub PrintListOfAllBusyAppointments()
    Dim objStore As Store
    Dim objFolder As Folder
 
    dStart = InputBox("Enter the start date:", , Date)
    dEnd = InputBox("Enter the end date:", , Date + 30)
 
    Set objExcelApp = CreateObject("Excel.Application")
    Set objExcelWorkbook = objExcelApp.Workbooks.Add
    Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
    objExcelApp.Visible = True
 
    With objExcelWorksheet
         .Cells(1, 1) = "Subject"
         .Cells(1, 1).Font.Bold = True
         .Cells(1, 2) = "Location"
         .Cells(1, 2).Font.Bold = True
         .Cells(1, 3) = "Start"
         .Cells(1, 3).Font.Bold = True
         .Cells(1, 4) = "End"
         .Cells(1, 4).Font.Bold = True
         .Cells(1, 5) = "In Folder"
         .Cells(1, 5).Font.Bold = True
    End With
 
    For Each objStore In Application.Session.Stores
        For Each objFolder In objStore.GetRootFolder.Folders
            If objFolder.DefaultItemType = olAppointmentItem Then
               Call ProcessFolders(objFolder)
            End If
        Next
    Next
 
    objExcelWorksheet.Columns("A:E").AutoFit
    objExcelWorksheet.PrintOut
    objExcelWorkbook.Close False
    objExcelApp.Quit
End Sub

Sub ProcessFolders(ByVal objCurFolder As Folder)
    Dim strFilter As String
    Dim objItems As Outlook.Items
    Dim objRestrictedItems As Outlook.Items
    Dim objAppointment As AppointmentItem
    Dim nLastRow As Integer
    Dim objSubFolder As Folder
 
    Set objItems = objCurFolder.Items
    objItems.IncludeRecurrences = True
    objItems.Sort "[Start]"
 
    'Get the appointments in the specific date range
    strFilter = "[Start] >= " & Chr(34) & dStart & " 00:00 AM" & Chr(34) & " AND [End] <= " & Chr(34) & dEnd & " 11:59 PM" & Chr(34)
    Set objRestrictedItems = objItems.Restrict(strFilter)

    For Each objAppointment In objRestrictedItems
        If objAppointment.BusyStatus = olBusy Then
           nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
 
           With objExcelWorksheet
                .Range("A" & nLastRow) = objAppointment.Subject
                .Range("B" & nLastRow) = objAppointment.Location
                .Range("C" & nLastRow) = objAppointment.Start
                .Range("D" & nLastRow) = objAppointment.End
                .Range("E" & nLastRow) = objCurFolder.FolderPath
           End With
        End If
    Next

    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubFolder In objCurFolder.Folders
           Call ProcessFolders(objSubFolder)
       Next
    End If
End Sub

VBA коды - барлық бос емес кездесулердің тізімін нақты күн ауқымында басып шығарыңыз

  1. Кейінірек бірінші ішкі бағдарламаны нұқып, «F5» батырмасын басыңыз.
  2. Әрі қарай, сізден кездесулерді іздеуге арналған күндер ауқымын көрсету қажет болады.Күндер ауқымын көрсетіңіз
  3. Кейін макросты жалғастыру үшін «OK» батырмасын басыңыз.
  4. Сонымен, макро аяқталғаннан кейін, төмендегі скриншотта көрсетілгендей, барлық күнтізбелік қалталарда алдын-ала белгіленген күндер ауқымындағы бос кездесулер тізімі басылып шығады.Белгілі бір күндер ауқымындағы бос емес кездесулердің тізімі

Outlook-тің алаңдаушылығымен күресу

Егер сіздің Outlook әрдайым дұрыс емес түрде жабық болса, кейінірек көптеген мәселелер туындауы мүмкін. Олардың ішінде Outlook файлы бүлінген - ең нашар. Егер сіз өз деректеріңізді жоғалтқыңыз келмесе, сізге PST түзету құралын қолдану қажет, мысалы DataNumen Outlook Repair. Ол максималды деректерді қайтарып алуға қабілетті Outlook зақымдалған файл.

Автордың кіріспесі:

Ширли Чжан - деректерді қалпына келтіру бойынша сарапшы DataNumen, Соның ішінде деректерді қалпына келтіру технологиялары бойынша әлемдік көшбасшы болып табылатын Inc. sql түзету және бағдарламалық жасақтаманы жөндеу бағдарламалары. Қосымша ақпарат алу үшін кіріңіз WWW.datanumen.com

Қазір бөлісу:

Пікірлер жабылды.