如何從Excel數據創建約會?
假設您在Excel工作表中有一個約會數據表,如下面的屏幕快照所示,現在,您要將這些數據導入到Outlook日曆中。 您如何迅速處理這份工作?
使用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對像庫 選項從 可用參考 列錶框,請參見屏幕截圖:
4。 然後點擊 OK 按鈕,現在,按 F5 運行此代碼的關鍵,以及 選擇一個文件 顯示窗口,請選擇要導入到Outlook的Excel文件,請參見屏幕截圖:
5. 然後點擊 OK,將彈出一個提示框,如下所示:
6。 然後點擊 OK,Excel數據已導入到日曆中,如以下屏幕截圖所示:
最佳辦公生產力工具
Kutools for Outlook - 超過 100 種強大的功能可增強您的 Outlook
🤖 人工智慧郵件助手: 具備人工智慧魔力的即時專業電子郵件——一鍵天才回覆、完美語調、多語言掌握。輕鬆改變電子郵件! ……
📧 電子郵件自動化: 外出(適用於 POP 和 IMAP) / 安排發送電子郵件 / 發送電子郵件時按規則自動抄送/密件副本 / 自動轉送(進階規則) / 自動添加問候語 / 自動將多收件者電子郵件拆分為單獨的訊息 ...
📨 電子郵件管理: 輕鬆回憶電子郵件 / 按主題和其他人阻止詐騙電子郵件 / 刪除重複的電子郵件 / 進階搜索 / 合併資料夾 ...
📁 附件專業版: 批量保存 / 批量分離 / 批量壓縮 / 自動保存 / 自動分離 / 自動壓縮 ...
🌟 介面魔法: 😊更多又漂亮又酷的表情符號 / 使用選項卡式視圖提高 Outlook 工作效率 / 最小化 Outlook 而不是關閉 ...
👍 一鍵奇蹟: 使用傳入附件回覆全部 / 反網路釣魚電子郵件 / 🕘顯示寄件者的時區 ...
👩🏼🤝👩🏻 通訊錄和行事曆: 從選定的電子郵件中大量新增聯絡人 / 將聯絡人群組拆分為各組 / 刪除生日提醒 ...
超過 100特點 等待您的探索! 按此處了解更多。