0
我在excel中使用了一些引用电子邮件的文本（日期，发件人，主题）。问题是（就我所知），您可以超链接到公共文件夹中的Outlook电子邮件，因为电子邮件可能会移动（链接因PC而异）。在personal.xlsb中触发宏的超链接
所以我的想法是获取该电子邮件的目的是制作一个超链接，触发personal.xlsb中的宏，然后搜索该电子邮件并显示它。
我唯一的问题是，我不知道如何链接文本来启动宏，Worksheet_FollowHyperlink意味着我需要将该代码放在我的文本所在的工作表中。
我想我可以做到这一点，但这实现了我需要在工作簿打开时创建此代码并在工作簿关闭时将其删除，除非我必须将所有文件重命名为xlsm，并且因为我我不确定其他同事是否有链接到我希望避免这样做的Excel表格。
所以我的问题是，有什么办法可以制作超链接到personal.xlsb!ShowEmail(cellValue)？或者是否可以直接链接到公共文件夹中的电子邮件？下面是用于创建电子邮件文本代码：
Function getEpostField(projectNumber As String, drawingNumber As String, partNumber As String) As String
On Error Resume Next
Dim myFolderArray() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim OutApp As Object
Dim myNameSpace As Object
Dim myFolder As Object
Dim myNewFolder As Object
Dim TopPublicFolder As Object
Dim olMail As Variant
Dim myTasks
Dim strFilter As String
Set OutApp = CreateObject("Outlook.Application")
Set myNameSpace = OutApp.GetNamespace("MAPI")
Set TopPublicFolder = myNameSpace.GetDefaultFolder(18)
getEpostField = ""
' array with all subfolders where the item might be...
myFolderArray = Post.helpRequest("XXXXXXXXX")
For i = LBound(myFolderArray) To UBound(myFolderArray)
Set myFolder = TopPublicFolder.Folders("Prototech").Folders(myFolderArray(i, 2)).Folders
For j = 1 To myFolder.Count
If InStr(myFolder(j).Name, projectNumber) Then
If drawingNumber <> "" And partNumber <> "" Then
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & drawingNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & partNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & partNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & partNumber & "%'"
ElseIf drawingNumber <> "" Then
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & drawingNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & drawingNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & drawingNumber & "%'"
ElseIf partNumber <> "" Then
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%" & partNumber & "%' " _
& "or " & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & partNumber & "%'" _
& "or " & Chr(34) & "urn:schemas:httpmail:attachmentfilename" & Chr(34) & " like '%" & partNumber & "%'"
Else
getEpostField = "No emails found"
Exit Function
End If
Set filteredItems = myFolder(j).Items.Restrict(strFilter)
If filteredItems.Count = 0 Then
Debug.Print "No emails found"
getEpostField = "No emails found"
found = False
Else
found = True
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
attachmentString = ""
If itm.Attachments.Count > 0 Then
For Each temp In itm.Attachments
temp2 = InStr(temp.filename, drawingNumber)
If temp2 > 0 Then
attachmentString = attachmentString & temp.filename & " "
End If
Next temp
End If
Debug.Print "Dato:" & Format(itm.CreationTime, "mm.dd.yyyy") & " Subject:" & itm.Subject & " From:" & itm.SenderName & " Attachment:" & attachmentString
getEpostField = getEpostField + "Dato:" & Format(itm.CreationTime, "mm.dd.yyyy") & " Subject:" & itm.Subject & " From:" & itm.SenderName & " Attachment:" & attachmentString
Next
End If
'If the subject isn't found:
If Not found Then
'NoResults.Show
Else
Debug.Print "Found " & filteredItems.Count & " items."
End If
Exit Function
End If
Next j
Next i
End Function