从单元格引用插入dynamic超链接，并将其放置在复制范围之上

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

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

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

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）为了使文件链接dynamic化，你可以在文件path中join包含文件名的单元格的引用。

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

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

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 

另一个注意：另外，我不认为你需要在你的身体string"rngBody.Paste" ，因为这只是粘贴在你的电子邮件正文