Question

我是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

Answer 1

"<A href=" & chr(34) & "J:\Main Directory\" & Range("B" & lRow).Value & chr(34) & ">Description of Document </A>"

使用VBA在电子邮件中的Hyperlink中插入文本

1 个答案: