כיצד ליצור פגישה מנתוני Excel?

נניח, יש לך טבלה של נתוני פגישה בגליון עבודה של Excel כמו המסך הבא מוצג, עכשיו, אתה רוצה לייבא את הנתונים האלה לתוך לוח השנה של Outlook. איך אתה יכול להתמודד עם עבודה זו במהירות?

צור פגישות מתוך נתוני Excel עם קוד VBA

צור פגישות מתוך נתוני Excel עם קוד VBA

כדי ליצור פגישות מנתוני Excel, תוכל להחיל את קוד ה- VBA הבא, בצע את הפעולות הבאות:

1. הפעל את Outlook והחזק את המקש ALT + F11 מפתחות כדי לפתוח את Microsoft Visual Basic עבור יישומים חלון.

2. לחץ הַבלָעָה > מודול, והדבק את הקוד הבא מודול חַלוֹן.

קוד VBA: ייבוא ​​נתוני Excel לפגישה:

Public Sub CreateOutlookApptz()
    Dim xAppointmentItem As Outlook.AppointmentItem
    Dim xNameSpace As Outlook.NameSpace
    Dim xCalendarFld As Outlook.MAPIFolder, xSubFolder As Outlook.MAPIFolder
    Dim xCalendarStr As String
    Dim I As Long
    Dim xFileDialog As FileDialog
    Dim xFilePath As String
    Dim xExcelApp As Excel.Application
    Dim xWb As Workbook
    Dim xWs As Worksheet
    On Error GoTo Err_Execute
    Set xExcelApp = New Excel.Application
    Set xFileDialog = xExcelApp.FileDialog(msoFileDialogFilePicker)
    With xFileDialog
        .Title = "Select a file"
        .Filters.Add "Microsoft Excel", "*.xlsx"
    End With
    If xFileDialog.Show = 0 Then Exit Sub
    xFilePath = xFileDialog.SelectedItems(1)
    Set xWb = xExcelApp.Workbooks.Open(xFilePath)
    Set xNameSpace = Outlook.Application.Session
    Set xCalendarFld = xNameSpace.GetDefaultFolder(olFolderCalendar)
    I = 2
    Set xWs = xWb.Worksheets.Item(1)
    xCalendarStr = xWb.Name
    If FolderExist(xCalendarFld, xCalendarStr) = False Then
        Set xSubFolder = xCalendarFld.Folders.Add(xCalendarStr, olFolderCalendar)
    Else
        Set xSubFolder = xCalendarFld.Folders(xCalendarStr)
    End If
    Do Until Trim(xWs.Cells(I, 1).Value) = ""
        Set xAppointmentItem = xSubFolder.Items.Add(olAppointmentItem)
        With xAppointmentItem
            .Start = xWs.Cells(I, 5) + xWs.Cells(I, 6)
            .End = xWs.Cells(I, 7) + xWs.Cells(I, 8)
            .Subject = xWs.Cells(I, 1)
            .Location = xWs.Cells(I, 2)
            .Body = xWs.Cells(I, 3)
            .BusyStatus = olBusy
            .ReminderMinutesBeforeStart = xWs.Cells(I, 9)
            .ReminderSet = True
            .Categories = xWs.Cells(I, 4)
            .Save
        End With
        I = I + 1
    Loop
    Set xAppointmentItem = Nothing
    Set olApp = Nothing
    xExcelApp.Quit
    Set xExcelApp = Nothing
    MsgBox "Import successfully!", vbInformation, "Kutools for Outlook"
    Exit Sub
Err_Execute:
    MsgBox "An error occurred - Exporting items to Calendar.", vbInformation, "Kutools for Outlook"
End Sub
Function FolderExist(CalFolder As Folder, FolderName As String) As Boolean
    Dim I As Integer
    Dim xSubFolder As Folder
    For I = 1 To CalFolder.Folders.Count
        Set xSubFolder = CalFolder.Folders.Item(I)
        If xSubFolder.Name = FolderName Then
            FolderExist = True
            Exit Function
        End If
    Next I
End Function

3. עדיין ב Microsoft Visual Basic עבור יישומים חלון, לחץ על כלים > הפניות ללכת ל הפניות-Project1 תיבת הדו-שיח ובדוק ספריית אובייקטים של Microsoft Excel אפשרות מתוך הפניות זמינות רשימה, ראה צילום מסך:

4. לאחר מכן לחץ על OK כפתור, עכשיו, לחץ F5 המפתח להפעלת קוד זה, וכן בחר קובץ החלון מוצג, בחר את קובץ Excel שברצונך לייבא ל- Outlook, ראה צילום מסך:

5. ולאחר מכן לחץ על אישור OK, תיבת הפקודה היא popped החוצה כדלקמן:

6. לאחר מכן לחץ על OK, הנתונים של Excel יובאו ליומן כמו צילום המסך הבא שמוצג:

Kutools עבור Outlook

יותר מ 100 פונקציות מתקדמות עבור Outlook 2010, 2013, 2016, 2019 ו- 365

תכונות נוספות | הורדה חינמית | רק 39.00 $ עבור מאות פונקציות