VBA批量把WORD中的网址转换为超链接

沛文沛语

山水且为歌，诗酒趁年华

在用印象笔记和word整理微信聊天记录时会遇到这种类型的段落

这些原始记录在微信里如图2所示

需要整理发布到公众号上的格式如下图图3所示

如果直接复制粘贴过来在公众号编辑器里，当然不是图3这种格式。一种处理的方式是，在编辑器里，手动处理，选中超链接文本，剪切，选中前面的标题文本，点击编辑超链接。

这样做很容易出错，因为微信公众号的文章分享出来的时候，后面的链接很长，而且没有什么可以优化缩短的规律，链接多了还容易遗漏。好在微信公众号支持WORD文档导入，我们可以在把这些工作放在WORD里用宏自动完成。

到了发挥杀鸡要用牛刀的精神的时候了，假设我们遇到一个问题，不要一直用笨办法绕过这个问题，试着用不同的表述方式去搜索这个问题。

只要你有一个准确的问题，99.9%的可能性你会找到一个不错的答案。

但最近遇到的这几个问题，都属于那0.1%的范畴。

如果努力之后确定答案不属于那99.9%，那么我们就努力扩大一下这99.9%的范围。

第一步：观察文本特征

聊天记录里出现的带有http链接的段落，是我们要整理的目标对象，例如

但是微信公众号里仅支持在微信公众号平台发布的文章链接

所以我们只需要整理来自微信公众号的链接文本。接下来观察这些段落的文本特征，用正则表达式写出来 第二步：用正则表达式匹配 用strSearch来代表搜索关键词的变量，通过开头的网址【 http:// mp.weixin.qq.com 】即可定位到微信公众号的链接，正则表达式写为

strSearch = "([[])(*http://mp.weixin.qq.com*)([]])"

这里总共有三个圆括号第一个圆括号，代表的是该段以左方括号开头，需要用一个元字符左右方括号括起来才可以

第二个圆括号里的内容分为三部分，左侧和右侧的星号*，表示可以匹配微信公众号网址两端的任意长度的内容。

第三个圆括号，逻辑和第一个一样，代表的是该段以右方括号开头，需要用一个元字符左右方括号括起来才可以。

如果没有第一个和第三个圆括号，那么这个正则表达式匹配的范围就会扩大，出现误选。测试一下，出现下面这样的匹配

分析一下误选的原因，是因为http前面的星号*，这个通配符表示的是可以匹配任意长度的文本。

结果就把上一个包含“[”的文本开头匹配上了，这不是我们想要的结果。所以我们需要重新分析含有超链接段落的文本独特特征，需要对这里的通配符“*”做调整。

由于http前面和方括号之间对应的是文章标题，而微信的文章标题其实是有规律可循的

微信公众号的文章标题长度不能超过64个字符。那么我们就可以用限定方括号和http文本之间的字符长度来做到精确匹配。文章标题的长度是1到64，字符类型不设限制，这个表达式尝试写为

(?{1,64})

在一般的编程语言正则表达式里，代表任意单个字符的元字符是点"."，但是在word VBA语言里，代表单个字符的元字符不是点，而是问号“?”更新后的正则表达式写为。

strSearch = "([[])(?{1,64})(: http://mp.weixin.qq.com*)([]])"

继续进行测试

还是出现了过度匹配，看来通过“?”限定字符长度的方式是走不通了。具体的原因，我找了很多资料，请教了专家，暂时也没找到合适的分析。

还有一种思路是限定字符类型，也就是把这里的问号“?”替换为中文，英文，数字和标点符号这些标题里常用的字符集合，然后限定一下标题长度。但是风险是可能哪一次标题里出现了不在字符集合里的字符，就会匹配错误。这个我进行过测试，可以正常匹配，表达式的长度比较长，就不放在这里了。

再换一个思路，先不在正则表达式这里纠结， 问题的解决往往不在问题的发生层面 。我们把含有超链接的段落的正则表达式先精简一些改为

strSearch = "([[])(*)([]])"

也就是说，我们先匹配含有超链接的所有段落，或者说所有以左右方括号开头结尾的段落，然后再用If函数进行判断，这个段落里是否还有特定的关字符：【 http:// mp.weixin.qq.com 】

这里用instr函数求出微信公众号文章链接的特定字符【 http:// mp.weixin.qq.com 】在目标段落里出现的位置，如果有，返回的数值肯定大于1，如果没有就是0。这样就解决了精确识别含有微信公众号文章链接的问题。 第三步：编写并调试VBA代码

完整代码如下

Sub 微信公众号超链接批量整理()
    Dim strSearch As String
    Dim mypos As Integer
    strSearch = "([[])(*)([]])" '适用于微信公众号，因为微信公众号仅支持公众号内的文章链接作为超链接。?{1,64}不能有效表示对字符长度的限制
    '可以在正则表达式里用较为简单的
    Selection.HomeKey unit:=wdStory '从头开始搜索，需要把默认光标调整到文档起始位置
    Selection.Find.ClearFormatting
    With Selection.Find '不能用ActiveDocument.Content.Find，不支持正则表达式，需要调整一下查找函数，改为对段落文本进行查找
        .Text = strSearch
        .Forward = True
        .Format = False
        .MatchWildcards = True
        Do While .Execute
        t = Selection.Range.Text
        mypos = InStr(1, t, "http://mp.weixin.qq.com")
            If mypos <> 0 Then
                n = ActiveDocument.Range(0, Selection.Range.End).Paragraphs.Count '返回当前循环过程中p1对应的段落序号
                adress = "http://mp.weixin.qq.com" & Replace(Split(Selection.Range.Text, "http://mp.weixin.qq.com")(1), "]", "")
                title = Replace(Replace(Split(Selection.Range.Text, "http://mp.weixin.qq.com")(0), "[", ""), ":", "")
                ActiveDocument.Paragraphs(n).Range.Delete
                ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
                   adress _
            , TextToDisplay:=Replace("《" & title & "》", " ", "") & vbCr