在 Lotus / IBM Notes 发送的电子邮件中插入文件链接的 VBA 代码

如何解决在 Lotus / IBM Notes 发送的电子邮件中插入文件链接的 VBA 代码

根据在 StackOverflow 上找到的代码 here，我可以使用 Excel VBA 从 IBM Notes 发送电子邮件。 代码中唯一缺少的是如何发送带有共享文件夹中文件链接的电子邮件。我四处寻找代码，但不幸的是没有找到它。我正在拼命寻找与下面代码格式相同的代码。下面的代码包括我的签名，而其他代码如 this 没有，因为我没有 HTML 签名，也无法创建它。

请帮助我使用 emailBody(3) 在电子邮件正文中包含文件名和该文件的链接。 另一种方法对我来说没问题，只要我还有签名和文件链接。需要明确的是：我不需要包含附件，但需要包含指向文件的（超）链接。 我认为代码应该很简单，但不幸的是，它似乎并非如此。

我的代码如下，只有 LinkToFile 部分不起作用：

    Sub Send_Email_With_IBM_Notes()

Dim UserName As String,Maildbname As String,Recipient As String
Dim Maildb As Object,MailDoc As Object,session As Object
Dim emailBody(1 To 3) As String,EmailBodyTotal As String
Dim notesUIDoc As Object  
Dim FileName as string,LinkToFile as string

FileName = "Excel-File"
LinkToFile = "Location/Excel-File.xlsx"

With Application
    .ScreenUpdating = False
    .displayAlerts = False

    Set session = CreateObject("Notes.NotesSession")
    UserName = session.UserName
    Maildbname = Left$(UserName,1) & Right$(UserName,(Len(UserName) - InStr(1,UserName," "))) & ".nsf"
    Set Maildb = session.GetDatabase("",Maildbname)
    If Maildb.IsOpen = True Then
    Else
        Call Maildb.OPENMAIL
    End If

    Recipient = "Email Addresses"
    
    emailBody(1) = "Good morning,"
    emailBody(2) = "Please see below link:"
    emailBody(3) = FileName & LinkToFile
    EmailBodyTotal = Join(emailBody,vbCrLf & vbCrLf)
    
    ' Create New Mail and Address Title Handlers
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.SendTo = Recipient
    MailDoc.subject = FileName

    'displays email message without sending; user needs to click Send
    Set workspace = CreateObject("Notes.NotesUIWorkspace")
    Set notesUIDoc = workspace.EDITDOCUMENT(True,MailDoc)
    Call notesUIDoc.gotofield("Body") 'Go to the body,keep your signature.
    Call notesUIDoc.InsertText(EmailBodyTotal & vbCrLf) 'Add text above signature
  
    Set Maildb = nothing
    Set MailDoc = nothing
    Set session = nothing

    .ScreenUpdating = True
    .displayAlerts = True
End With

End Sub

解决方法

我建议使用 COM 接口/类而不是 OLE。使用 COM 时，您可以访问 Notes/Domino 中的所有后端类，这更加灵活和强大。您可以使用 Notes.NotesSession 代替 Lotus.NotesSession。

然后，您可以（可能）使用 NotesRichText 类将热点链接插入到网络共享上的文件（假设收件人已映射与您相同的网络文件夹）。

这是一个指向 Lotusscript 类的链接，用于从应用程序创建电子邮件通知，您应该能够将其调整为适用于 VBA 没有任何大问题：
Assignment Statements

更新 2021-06-22： 这是一些代码。所有这些都可以在 http://blog.texasswede.com/lotusscript-mail-notification-class/ 中找到。您应该仔细查看 NotesRichTextItem 类和 NotesDocument 类。
只需将以 Displays email message without sent 开头的评论后的所有内容替换为以下内容：

Dim body As Object
Set body = MailDoc.CreateRichTextItem("Body") 
Call body.AppendText("Good morning,")
Call body.AddNewLine(2)
Call body.AppendText("Please see below link:")
Call body.AddNewLine(1)
Call body.AppendDocLink(LinkToFile,"[Link to File]","Click here...")
Call MailDoc.Send()

如果您没有获得与上述代码一起使用的链接，您可以使用 AppendText() 方法插入链接 URL，希望收件人电子邮件客户端能够正确显示链接。

,

感谢大家的贡献！

不幸的是，这不是 100% 的解决方案，但是当我使用 Application.Sendkeys 和 NumLockOn 时，它大部分时间都有效，因为 sendkeys 关闭了 NumLock。 Sendkeys之间的Timevalue很重要！！

这是我（或多或少）为感兴趣的人提供的工作代码：

    Sub Send_Email_With_IBM_Notes()
    
    Dim UserName As String,MailDbName As String,Recipient As String 
    Dim Maildb As Object,MailDoc As Object,session As Object 
    Dim emailBody(1 To 4) As String 'changed
    Dim EmailBodyTotal As String 
    Dim notesUIDoc As Object   
    Dim FileName as string,LinkToFile as string
    
    FileName = "Excel-File" LinkToFile = "Location/Excel-File.xlsx"
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    
        Set session = CreateObject("Notes.NotesSession")
        UserName = session.UserName
        MailDbName = Left$(UserName,1) & Right$(UserName,(Len(UserName) - InStr(1,UserName," "))) & ".nsf"
        Set Maildb = session.GetDatabase("",MailDbName)
        If Maildb.IsOpen = True Then
        Else
            Call Maildb.OPENMAIL
        End If
    
        Recipient = "Email Addresses"
        
        emailBody(1) = "Good morning,"
        emailBody(2) = "Please see below link:"
        emailBody(3) = FileName 
        emailBody(4) = LinkToFile 'changed
        EmailBodyTotal = Join(emailBody,vbCrLf & vbCrLf)
        
        ' Create New Mail and Address Title Handlers
        Set MailDoc = Maildb.CreateDocument
        MailDoc.Form = "Memo"
        MailDoc.SendTo = Recipient
        MailDoc.subject = FileName
    
        'Displays email message without sending; user needs to click Send
        Set workspace = CreateObject("Notes.NotesUIWorkspace")
        Set notesUIDoc = workspace.EDITDOCUMENT(True,MailDoc)
        Call notesUIDoc.gotofield("Body") 'Go to the body,keep your signature.
        Call notesUIDoc.InsertText(EmailBodyTotal & vbCrLf) 'Add text above signature

    'The whole part below is new ***
    AppActivate ("Notes")
    Application.Wait (Now() + TimeValue("00:00:02"))
    Application.SendKeys "{Left}"
    Application.SendKeys "+{HOME}"
    Application.Wait (Now() + TimeValue("00:00:02"))
    Application.SendKeys "^x"
    Application.SendKeys "{BS}"
    Application.SendKeys "{BS}"
    Application.Wait (Now() + TimeValue("00:00:01"))
    Application.SendKeys "+{HOME}"
    Application.Wait (Now() + TimeValue("00:00:02"))
    Application.SendKeys ("{F10}M") 'Application.SendKeys "^M" does not work!!
    Application.Wait (Now() + TimeValue("00:00:01"))
    Application.SendKeys "y"
    Application.Wait (Now() + TimeValue("00:00:01"))
    Application.SendKeys "^v"
    Application.Wait (Now() + TimeValue("00:00:01"))
    Application.SendKeys "~"
    NumLockOn
    'Part is new until here ***

        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set session = Nothing
    
        .ScreenUpdating = True
        .DisplayAlerts = True End With
    
    End Sub

Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Sub NumLockOn() 
Dim NumLockState As Boolean
Let NumLockState = CBool(GetKeyState(vbKeyNumlock) And 1)
If NumLockState = False Then
SendKeys "{NUMLOCK}",True
End If
End Sub