excel - 将 Excel VBA 中的超链接添加到 Outlook 约会
问题描述
我的代码在各个方面都可以正常工作,但我找不到在 Outlook 约会中创建超链接的方法。地址放在Excel的H列,我想用VBA把它导出到某个日历。任何帮助将不胜感激。
我的代码如下:
Sub Appointments()
Const olAppointmentItem As Long = 1
Dim OLApp As Object
Dim OLNS As Object
Dim OLAppointment As Object
Dim miCalendario As Object
Dim r As Long
On Error Resume Next
Set OLApp = GetObject(, "Outlook.Application")
If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0
If Not OLApp Is Nothing Then
Set OLNS = OLApp.GetNamespace("MAPI")
OLNS.Logon "Outlook"
b = 1
r = 2
Dim mysub, myStart, myEnd, mydes, myallday
While Len(Cells(r, 5).Text) <> 0
mysub = Cells(r, 7)
If Not Cells(r, 13).Value = 0 Then
mysub = mysub & "(s. " & Cells(r, 13).Value & ")" & vbCrLf
End If
'& ", " & Cells(r, 3)
myStart = DateValue(Cells(r, 1).Value) + Cells(r, 2).Value
myEnd = DateValue(Cells(r, 1).Value) + Cells(r, 3).Value
mydes = ""
Set miCalendario = OLApp.Session.GetDefaultFolder(9).Folders(ActiveSheet.Name)
Set OLAppointment = miCalendario.Items.Add(olAppointmentItem)
Dim olItems As Items
Dim olApptItem As Outlook.AppointmentItem
Set olItems = miCalendario.Items
Set olApptItem = miCalendario.Items.GetFirst
'add appointments
On Error Resume Next
With OLAppointment
.Subject = mysub
.Start = myStart
.End = myEnd
.Body = mydes
If Not Cells(r, 1).Value = 0 Then
If Not Cells(r, 8).Value = 0 Then
mydes = mydes & Cells(1, 8).Value & " - " & Cells(r, 8).Value & vbCrLf
End If
.Body = mydes
End If
.Location = Cells(r, 4).Value .Save
End With
r = r + 1
b = b + 1
Wend
Set OLAppointment = Nothing
Set OLNS = Nothing
Set OLApp = Nothing
End If
End Sub
解决方案
您需要使用 .HTMLBody insted .Body
.HTMLbody = <a href="link">"link_Mask"</a>
我希望它会有所帮助
推荐阅读
- c++ - 为什么 erase() 函数只有第一次才能正常工作?
- database - laravel - 获取最后一条记录
- ios - 以编程方式创建的 UINavigationController 中不显示 iOS 14 导航栏标题
- mongodb - 如何更新嵌套数组以向每个元素添加唯一的 ObjectId?
- laravel - 我应该将所有逻辑都放在 Laravel 策略中吗?
- android - 通知未显示
- jquery - jquery on click 只工作两次
- javascript - 我有 3 个变量(型号代码、数量、日期)在另一张表中找到相同的型号代码、日期并将值设置为 Q'ty
- python - 数据框列表,如果行包含特殊字符串,则删除数据框列(列具有不同的名称)
- javascript - 打字稿 - 未定义命名空间问题