VBA 使用超链接发送邮件给对应的人员

背景

背景：
已经存在使用Excel获取文件夹下所有文件的超链接，其中所有的超链接都存在对应的单元格内，以及对应的人员名单，

目标

需要将超连接用邮件发送给对应的人员。

使用VBA学习使用过程中，需要对超链接地址进行提取，再在邮件中发送超级连接，找了找，找到如下方法
第一步：先使用Address获取地址
第二步；使用Split 命令，获取所需要的字符串

代码

第一步实现：

Sub InsertHyperlink()

Dim objOL As Object
Dim itmNewMail As Object
Dim Hyp As String

Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(0)

Hyp = "<a href=""http:\\www.baidu.com"">Click here</a>"
With itmNewMail
    .Subject = "I am Subject of this email"
    **.HTMLBody = "<H1>Below is the example of email with Hyperlink</H1><br>" + Hyp**
    .To = "Input Receiver"
    .cc = "Input Receiver"
    .Display
End With

End Sub

使用HTMLBody ：

.HTMLBody = "<H1>Below is the example of email with Hyperlink</H1><br>" + Hyp

就可以再邮件正文中添加超链接，然后对于超链接的提取就需要使用到其他地址中的路径信息，进行提取相关的文件，本文中产品的连接都提前使用Dir放入到对应的表格列表中，所以需要将单元格里的hyperlinks内容进行提取，然后获取其中的字符就OK了，如下使用split实现这个功能：

    For Each h In Sheet1.Hyperlinks
      With h
        arr = Split(.Address, "/")
        .Address = "C:\Documents and Settings\aa\桌面\文件\2008-2013 资料" & arr(UBound(arr))
      End With
    Next

Private Sub Constant_demo_Click()
   ' Splitting based on delimiter comma '$'
   Dim a as Variant
   Dim b as Variant

   a = Split("Red $ Blue $ Yellow","$")
   b = ubound(a)

   For i = 0 to b
      msgbox("The value of array in " & i & " is :"  & a(i))
   Next
End Sub

将会输出如下结果：

The value of array in 0 is :Red 
The value of array in 1 is : Blue 
The value of array in 2 is : Yellow

其他知识：
Split()函数返回一个数组，其中包含基于分隔符分割的特定数量的值
语法
Split(expression[,delimiter[,count[,compare]]])
参数说明

Expression - 必需的参数。可以包含带分隔符的字符串的字符串表达式。Delimiter - 一个可选参数。该参数用于根据分隔符转换为数组。Count - 一个可选参数。要返回的子字符串的数量，如果指定为-1，则返回所有子字符串。Compare - 一个可选参数。该参数指定要使用哪种比较方法。
0 = vbBinaryCompare - 执行二进制比较1 = vbTextCompare - 执行文本比较/

VBA邮件的代码

默认用outlook发邮件，代码如下:

Private Sub CommandButton1_Click()
  
  On Error Resume Next
  Dim rowCount, endRowNo As Integer
  Dim objOutlook As New Outlook.Application
  Dim objMail As MailItem
  endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
  Set objOutlook = New Outlook.Application

  Dim objData As New DataObject
    For rowCount = 2 To endRowNo
        Set objMail = objOutlook.CreateItem(olMailItem)
           
           With objMail
             .To = Cells(rowCount, 1).Value     '"收件人"
             .CC = Cells(rowCount, 2).Value     '"抄送人"
             .Subject = Cells(rowCount, 3).Value '"邮件主题"
             .HTMLBody = Cells(rowCount, 4).Value & getVal(rowCount) & "  " & Cells(rowCount, 5).Value '正文
              .Display
           End With
        Set objMail = Nothing
   Next
Set objOutlook = Nothing
End Sub