excel - 通过 64 位 Excel 引用共享日历
问题描述
我们创建了一个 VBA 脚本,通过单击 Excel 工作表中的按钮(已授予共享日历权限)从 MS Outlook 中提取“共享日历”。虽然代码在开发人员系统上运行良好,但它无法在其他系统上运行。它显示的错误是:
请提出代码不起作用的可能原因。我们认为的原因之一可能是开发人员拥有 Office 365 的 32 位版本,而其他人拥有相同的 64 位版本。
附上代码供您参考:
Sub ListAppointments()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date
Dim CalendarFolder As Outlook.Folder
Dim myNameSPace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient
Dim k, q As Long
Dim abc(), fDate, tDate As String
Dim i As Integer
Sheets("Main").Select
fDate = Range("B2").Value
tDate = Range("C2").Value
FromDate = CDate(fDate)
ToDate = CDate(tDate)
Sheets("Associates").Select
k = Sheets("Associates").Range("A1048576").End(xlUp).Row
k = k - 2
ReDim abc(k)
abc(0) = ""
q = 0
For i = 2 To k + 2
abc(q) = Cells(i, 1).Value
q = q + 1
Next i
Sheets("Main").Select
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set myNameSPace = Outlook.Application.GetNamespace("MAPI")
'NextRow = 5
'Starting multiple associates loop
i = 0
For i = 0 To k
Set myRecipient = myNameSPace.CreateRecipient(abc(i))
myRecipient.Resolve
If myRecipient.Resolved Then
Set CalendarFolder = myNameSPace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
End If
q = Sheets("Main").Range("A1048576").End(xlUp).Row
q = q + 1
If q = 2 Then
q = q + 3
End If
NextRow = q
With Sheets("Main") 'Change the name of the sheet here
.Range("A4:E4").Value = Array("Project", "Date", "Time spent", "Location", "User Email")
For Each olApt In CalendarFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
.Cells(NextRow, "A").Value = olApt.Subject
.Cells(NextRow, "B").Value = CDate(olApt.Start)
.Cells(NextRow, "C").Value = olApt.End - olApt.Start
.Cells(NextRow, "C").NumberFormat = "HH:MM:SS"
.Cells(NextRow, "D").Value = olApt.Location
.Cells(NextRow, "E").Value = abc(i)
NextRow = NextRow + 1
Else
End If
Next olApt
.Columns.AutoFit
End With
Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Next i
MsgBox ("Process Complete.")
End Sub
在这方面的任何帮助将不胜感激
解决方案
我们解决了它,只需要对这一行进行一点小改动:`
Set CalendarFolder = myNameSPace.GetSharedDefaultFolder(myRecipient, olFolderCalendar`)
我们所要做的就是在“olFolderCalendar”前面加上“outlook.olFolderCalendar”
Set CalendarFolder = myNameSPace.GetSharedDefaultFolder(myRecipient, outlook. olFolderCalendar)
推荐阅读
- macos - Vim 彻底坏了,不能用
- c# - Microsoft Access 的 OleDbConnection.State 问题
- python - 如何检查是否在 tkinter python 中编辑了文本小部件?
- mysql - mysql上END附近的事件计划错误标记
- java - 在 onComplete 方法中实现接口的问题
- python - 在 python 中与 linux 控制台交互
- java - Android 应用程序语言随处变化,但在菜单和选项卡布局标题中没有变化
- python - 如何删除数据库中带有条件的行?
- python - model.predict_generator() 中的死锁与 use_multiprocessing=True
- r - 为什么 car 包中的 vif() 结果与 lmridge R 中的结果不同?