Πώς να δημιουργήσετε ραντεβού από τα δεδομένα του Excel;

Ας υποθέσουμε ότι έχετε έναν πίνακα δεδομένων ραντεβού σε ένα φύλλο εργασίας του Excel όπως φαίνεται το παρακάτω στιγμιότυπο οθόνης, τώρα, θέλετε να εισαγάγετε αυτά τα δεδομένα στο ημερολόγιο του Outlook. Πώς θα μπορούσατε να αντιμετωπίσετε αυτήν την εργασία γρήγορα;

doc εξαγωγή δεδομένων excel στο ραντεβού 1

Δημιουργήστε ραντεβού από δεδομένα 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 για εφαρμογές παράθυρο, κάντε κλικ στην επιλογή Εργαλεία > αναφορές για να μεταβείτε στο Αναφορές-Έργο 1 πλαίσιο διαλόγου και επιλέξτε Βιβλιοθήκη αντικειμένων του Microsoft Excel Επιλογή από το Διαθέσιμες αναφορές πλαίσιο λίστας, δείτε το στιγμιότυπο οθόνης:

doc εξαγωγή δεδομένων excel στο ραντεβού 2

4. Στη συνέχεια κάντε κλικ στο κουμπί OK κουμπί, τώρα, πατήστε F5 κλειδί για την εκτέλεση αυτού του κώδικα, και a Επιλέξτε ένα αρχείο εμφανίζεται το παράθυρο, επιλέξτε το αρχείο excel που θέλετε να εισαγάγετε στο Outlook, δείτε το στιγμιότυπο οθόνης:

doc εξαγωγή δεδομένων excel στο ραντεβού 3