【发布时间】: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\& Cells(lRow, B).Value",你需要"J:\Main Directory\" & Cells(lRow, B).Value & "Rest of String"