Hello,
I am fairly new to VBA and I am trying to understand how it really works.
So currently I have an excel sheet with items that have due dates.I was able to look online and send out emails to certain people with their respective due dates. Each email has a link to the excel file thats on a network drive.
However, now I am required to link to somewhere else where each item has a folder. The trick to this is that there is a directory where each item is placed in this directory. They are all within in 1 folder. The folders have the same name as in the text in the excel sheet.
I was wondering if there is a way to take the text from the cell respective to each item and place it in the hyperlink? So depending on the item and when its due. The hyperlink will change every time so it goes to the specific folder. Here is the example of the structure. Y:\Main Directory\Folder 1 and another one would be Y:\Main Directory\Folder 3. I placed the name of each folder next to each item within the excel sheet. Also the column with the name of each folder is in column "B". How would I go about this? Thank you! Much appreciated!
Here is the code:
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 test 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)
test = Cells(lRow, "B").Value
'toDate = Replace(Cells(lRow, "R"), "/")
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 & "Please see" & Cells(lRow, "C") & vbCrLf
EBody = EBody &"Text" & vbCrLf
EBody = EBody & "Link to the Document:"
'Link to document
EBody = EBody & "<A href='Document'>Text for Document </A>" & vbCrLf
' The line below will have the hyperlink to the subfolders respective to the item that has the due date
EBody = EBody & "" & "<A href= 'Text'>Key Based Data </A>"
EBody = EBody & "</BODY></HTML>"
EBody = EBody &
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.<wbr>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
I am fairly new to VBA and I am trying to understand how it really works.
So currently I have an excel sheet with items that have due dates.I was able to look online and send out emails to certain people with their respective due dates. Each email has a link to the excel file thats on a network drive.
However, now I am required to link to somewhere else where each item has a folder. The trick to this is that there is a directory where each item is placed in this directory. They are all within in 1 folder. The folders have the same name as in the text in the excel sheet.
I was wondering if there is a way to take the text from the cell respective to each item and place it in the hyperlink? So depending on the item and when its due. The hyperlink will change every time so it goes to the specific folder. Here is the example of the structure. Y:\Main Directory\Folder 1 and another one would be Y:\Main Directory\Folder 3. I placed the name of each folder next to each item within the excel sheet. Also the column with the name of each folder is in column "B". How would I go about this? Thank you! Much appreciated!
Here is the code:
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 test 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)
test = Cells(lRow, "B").Value
'toDate = Replace(Cells(lRow, "R"), "/")
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 & "Please see" & Cells(lRow, "C") & vbCrLf
EBody = EBody &"Text" & vbCrLf
EBody = EBody & "Link to the Document:"
'Link to document
EBody = EBody & "<A href='Document'>Text for Document </A>" & vbCrLf
' The line below will have the hyperlink to the subfolders respective to the item that has the due date
EBody = EBody & "" & "<A href= 'Text'>Key Based Data </A>"
EBody = EBody & "</BODY></HTML>"
EBody = EBody &
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.<wbr>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
