Cookies幫助我們提供服務。 使用我們的服務即表示您同意我們使用cookies。
提示:其他語言是Google翻譯的。 你可以訪問 English 版本。
登入
x
or
x
x
註冊
x

or

如何從Excel數據創建約會?

假設您在Excel工作表中有一個約會數據表,如下所示,現在,您要將這些數據導入Outlook日曆。 你怎麼能快速處理這項工作?

doc將excel數據導出到約會1

使用VBA代碼從Excel數據創建約會


使用VBA代碼從Excel數據創建約會

要從Excel數據創建約會,您可以應用以下VBA代碼,請執行以下操作:

1。 啟動Outlook並按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

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 for Applications 窗口中,單擊 工具 > 參考參考-Project1 對話框,並檢查 Microsoft Excel對像庫 選項從 可用的參考 列錶框,看截圖:

doc將excel數據導出到約會2

4。 然後點擊 OK 按鈕,現在,按 F5 運行這個代碼的關鍵,和一個 選擇一個文件 窗口顯示,請選擇要導入Outlook的Excel文件,見截圖:

doc將excel數據導出到約會3

5. 然後點擊 OK,彈出一個提示框,如下所示:

doc將excel數據導出到約會4

6。 然後點擊 OK,Excel數據已導入日曆,如下所示:

doc將excel數據導出到約會5



Kutools for Outlook

超過100高級功能的Outlook 2010,2013,2016,2019和365

屏幕截圖kutools for outlook tiny for banner 201812

更多功能 | 免費下載 | 只有$ 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.

Be the first to comment.