Question

我正在运行通过电子邮件分发的报告。在电子邮件中是指向报告的超链接以及从中复制出来的一系列单元格，作为报告内容的快照。我正在尝试自动化并找到一些VBA，但我不是程序员，不能根据我的需要修改它。

下面的VBA让我大部分时间，但有两个缺点：

1）我需要超链接指向我在电子邮件中引用的特定文件，该文件每天更改（即创建一个唯一的工作簿）。下面使用静态超链接。我试图找出一种从单元格引用中获取超链接的方法。

2）将excel中的超链接和单元格范围复制到电子邮件中时，我需要超链接下方的单元格。以下将范围置于超链接之上。

我想保留以下VBA中引用工作表来获取电子邮件的方法。它似乎很容易部署在其他分发的报告上。

Sub CreateMail（）

    Dim rngSubject As Range
    Dim rngTo As Range
    Dim rngCc As Range
    Dim rngBody As Range
    Dim objOutlook As Object
    Dim objMail As Object

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
        With ActiveSheet
        Set rngTo = .Range("B1")
        Set rngCc = .Range("B3")
        Set rngSubject = .Range("B2")
        Set rngBody = .Range("H6:K22")

    End With
    rngBody.Copy
     With objMail
        .Body = "Please click on the link below..." & vbCrLf & "rngBody.Paste" & vbCrLf & _
"file:\\dbd03\nccode\Router_Proc\04Routing.txt"
    End With
    With objMail
        .To = rngTo
        .Cc = rngCc
        .Subject = rngSubject

        .Display
    End With
    SendKeys "^({v})", True

    Set objOutlook = Nothing
    Set objMail = Nothing

Answer 1

1）要使文件链接动态化，您只需在文件路径中包含包含文件名的单元格的引用。

"<file:\\dbd03\nccode\Router_Proc\" & _
        ActiveSheet.Range(<cell address here>) & ">"

注意：您可能还需要检查以确保路径存在（like this），然后再将其放入电子邮件中

2）要粘贴超链接下面的单元格，您可以使用另一个SendKeys组合来模拟按 Ctrl + End ，这将放置光标在电子邮件的末尾。在使用SendKeys模拟 Ctrl + V 之前执行此操作应该粘贴正文后面的单元格区域。您的更新代码应如下所示：

With objMail
    .To = rngTo
    .Cc = rngCc
    .Subject = rngSubject
    .Display
End With
SendKeys "^({END})", True '<--- Add this line HERE
SendKeys "^({v})", True

另一个注意事项：此外，我认为您的Body字符串中不需要"rngBody.Paste"，因为这只是在您的电子邮件正文中粘贴了确切的文本

从单元格引用插入动态超链接并将其放在复制的范围上方

1 个答案: