【问题标题】:Insert text from cell within Hyperlink in a email using VBA使用 VBA 在电子邮件中从超链接中的单元格插入文本
【发布时间】:2015-01-14 11:02:28
【问题描述】:

我对 VBA 还很陌生,我正在尝试了解它的实际工作原理。

所以目前我有一个包含截止日期的项目的 Excel 表。我能够在网上查看并向某些人发送电子邮件,其中包含各自的截止日期。每封电子邮件都有一个指向网络驱动器上的 excel 文件的链接。

但是,现在我需要链接到每个项目都有一个文件夹的其他地方。这样做的诀窍是有一个目录,每个项目都放在这个目录中。它们都在 1 个文件夹中。这些文件夹的名称与 Excel 工作表中的文本名称相同。

我想知道是否有一种方法可以将单元格中的文本分别用于每个项目并将其放置在超链接中?因此,取决于项目和到期时间。超链接每次都会更改,因此它会转到特定文件夹。这是结构的示例。 Y:\Main Directory\Folder 1 和另一个是 Y:\Main Directory\Folder 3。我将每个文件夹的名称放在 Excel 表中的每个项目旁边。每个文件夹名称的列也在“B”列中。我该怎么办?谢谢!非常感谢!

代码如下:

 Option Explicit



    Public Sub CheckAndSendMail()
     Dim lRow As Long
     Dim lstRow As Long
     Dim toDate As Date
     Dim toList As String
     Dim ccList As String
     Dim bccList As String
     Dim eSubject As String
     Dim EBody As String
     Dim vbCrLf As String





     Dim ws As Worksheet

     With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .DisplayAlerts = True


     End With

     Set ws = Sheets(1)
     ws.Select

     lstRow = WorksheetFunction.Max(3, ws.Cells(Rows.Count, "R").End(xlUp).Row)

     For lRow = 3 To lstRow

     toDate = CDate(Cells(lRow, "R").Value)


     If Left(Cells(lRow, "R"), 4) <> "Mail" And toDate - Date <= 7 Then
     vbCrLf = "<br><br>"



     toList = Cells(lRow, "F") 'gets the recipient from col F
     eSubject = "Text " & Cells(lRow, "C") & " is due on " & Cells(lRow, "R").Value
        EBody = "<HTML><BODY>"
        EBody = EBody & "Dear " & Cells(lRow, "F").Value & vbCrLf
        EBody = EBody & "Text" & Cells(lRow, "C") & vbCrLf
        EBody = EBody & "Text" & vbCrLf
        EBody = EBody & "Link to the Document:"
        EBody = EBody & "<A href='Hyperlink to Document'>Description of Document </A>" & vbCrLf
        'Line below is where the hyperlink to the folder directory and the different folder names
        EBody = EBody & "Text" & "<A href= 'Link to folder Directory\Variable based on                text'>Description </A>"
        EBody = EBody & "</BODY></HTML>"




     MailData msgSubject:=eSubject, msgBody:=EBody, Sendto:=toList

     'Cells(lRow, "W").Value = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column W"


     End If
     Next lRow


     ActiveWorkbook.Save


     With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .DisplayAlerts = True

     End With

     End Sub



     Function MailData(msgSubject As String, msgBody As String, Sendto As String, _
     Optional CCto As String, Optional BCCto As String, Optional fAttach As String)

     Dim app As Object, Itm As Variant
     Set app = CreateObject("Outlook.Application")
     Set Itm = app.CreateItem(0)
     With Itm
     .Subject = msgSubject
     .To = Sendto
     If Not IsMissing(CCto) Then .Cc = CCto
     If Len(Trim(BCCto)) > 0 Then
     .Bcc = BCCto
     End If
     .HTMLBody = msgBody
     .BodyFormat = 2 '1=Plain text, 2=HTML 3=RichText -- ISSUE: this does not keep HTML formatting -- converts all text
     'On Error Resume Next
     If Len(Trim(fAttach)) > 0 Then .Attachments.Add (fAttach) ' Must be complete path'and filename if you require an attachment to be included
     'Err.Clear
     'On Error GoTo 0
     .Save ' This property is used when you want to saves mail to the Concept folder
     .Display ' This property is used when you want to display before sending
     '.Send ' This property is used if you want to send without verification
     End With
     Set app = Nothing
     Set Itm = Nothing
     End Function 

【问题讨论】:

  • 您只需将所需的值连接到所需的 URL 中。看来您已经知道如何引用单元格了...
  • 那么我将如何专门更改代码行?我一直在尝试引用它,但它一直显示为文本。我不确定我是否做得对。这就是我正在做的事情。 "J:\Main Directory\& Cells(lRow, B).Value" 该路径在超链接内。
  • 我认为你的问题与HTML有关。试试this
  • @jbarker2160 我尝试使用“target=" 选​​项,但我的代码中不断出现语法错误。我还为文件夹名称的描述创建了一个变量,所以我尝试在 target= 中使用它,但它没有用。我做错了什么?
  • 变量需要在引号之外。 (如果我正确地阅读了您上面的答案评论)。你有"J:\Main Directory\&amp; Cells(lRow, B).Value",你需要"J:\Main Directory\" &amp; Cells(lRow, B).Value &amp; "Rest of String"

标签: html vba excel hyperlink


【解决方案1】:
"<A href=" & chr(34) & "J:\Main Directory\" & Range("B" & lRow).Value & chr(34) & ">Description of Document </A>"

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2016-05-19
    • 1970-01-01
    • 2018-03-25
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2017-04-24
    相关资源
    最近更新 更多