Zotero Word中插入带超链接的参考文献

Zotero 超链接

找了好多原代码，最接近能实施的为：
https://blog.csdn.net/weixin_47244593/article/details/129072589
但是，就是向他说的一样会报错，我修改了代码，遇见报错的地方会直接跳过不执行，事后找出自己再单独添加较为特殊文章即可，代码如下：

Public Sub ZoteroLinkCitation()
    On Error Resume Next ' Add this line to enable error handling
    Dim nStart&, nEnd&
    nStart = Selection.Start
    nEnd = Selection.End
    Application.ScreenUpdating = False
    Dim title As String
    Dim titleAnchor As String
    Dim style As String
    Dim fieldCode As String
    Dim numOrYear As String
    Dim pos&, n1&, n2&
    
    ActiveWindow.View.ShowFieldCodes = True
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^d ADDIN ZOTERO_BIBL"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="Zotero_Bibliography"
        .DefaultSorting = wdSortByName
        .ShowHidden = True
    End With
    ActiveWindow.View.ShowFieldCodes = False

    For Each aField In ActiveDocument.Fields
        ' check if the field is a Zotero in-text reference
        If InStr(aField.Code, "ADDIN ZOTERO_ITEM") > 0 Then
            fieldCode = aField.Code
            pos = 0
            Do While InStr(fieldCode, """title"":""") > 0
                n1 = InStr(fieldCode, """title"":""") + Len("""title"":""")
                n2 = InStr(Mid(fieldCode, n1, Len(fieldCode) - n1), """,""") - 1 + n1
            
                title = Mid(fieldCode, n1, n2 - n1)
                
                titleAnchor = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(title, " ", "_"), "&", "_"), ":", "_"), ",", "_"), "-", "_"), ".", "_"), "(", "_"), ")", "_"), "?", "_"), "!", "_")
                titleAnchor = Left(titleAnchor, 40)
                
                Selection.GoTo What:=wdGoToBookmark, Name:="Zotero_Bibliography"
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = Left(title, 255)
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindAsk
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute
                
                Selection.Paragraphs(1).Range.Select
                
                With ActiveDocument.Bookmarks
                    .Add Range:=Selection.Range, Name:=titleAnchor
                    .DefaultSorting = wdSortByName
                    .ShowHidden = True
                End With
                
                aField.Select
                            
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "^#"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                
                Selection.Find.Execute
                
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
                Selection.MoveRight Unit:=wdCharacter, Count:=pos
                
                Selection.Find.Execute
                Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
                Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
                
                numOrYear = Selection.Range.Text & ""
                
                pos = Len(numOrYear)
                
                style = Selection.style
                            
                ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", SubAddress:=titleAnchor, ScreenTip:="", TextToDisplay:="" & numOrYear
                aField.Select
                
                Selection.style = style
                'Selection.style = ActiveDocument.Styles("CitationFormating")
                
                fieldCode = Mid(fieldCode, n2 + 1, Len(fieldCode) - n2 - 1)
            
            Loop
        End If
    Next aField
    ActiveDocument.Range(nStart, nEnd).Select
End Sub

超链接颜色变化

在这里也给出全盘改变超链接颜色的代码：
参考链接如下：https://zhuanlan.zhihu.com/p/680291144

Sub CitingColor()
    For i = 1 To ActiveDocument.Fields.Count '遍历文档所有域
        ' Word 自带的交叉引用的域代码起始 4 位是 " REF" (注意空格)
        ' Endnote 插入的引用域代码的起始 14 位是 " ADDIN EN.CITE"
        ' Zotero 插入的引用域代码的起始 31 位是 " ADDIN ZOTERO_ITEM CSL_CITATION"，可根据需求添加其他类型
        If Left(ActiveDocument.Fields(i).Code, 4) = " REF" Or Left(ActiveDocument.Fields(i).Code, 14) = " ADDIN EN.CITE" Or Left(ActiveDocument.Fields(i).Code, 31) = " ADDIN ZOTERO_ITEM CSL_CITATION" Then
        ActiveDocument.Fields(i).Select ' 选中上述几类域
        Selection.Font.Color = wdColorBlue ' 设置字体颜色为蓝色，可改为其他颜色，如 RGB(255,0,0)
        End If
    Next
End Sub

给doi插入超链接

参考链接

Sub AddHyperlinksToDOIs()
    Dim doc As Document
    Dim rng As Range
    Dim field As field
    Dim doi As String
    Dim test As String
    Set doc = ActiveDocument
    Set rng = doc.Range
    
    With rng.Find
        .ClearFormatting
        .Text = "doi:*^13"
        .MatchWildcards = True
        .Wrap = wdFindStop
        .Forward = True
        
        Do While .Execute
            rng.MoveEnd wdCharacter, -1
            doi = rng.Text
            doi = Mid(doi, 6, Len(doi) - 6)
            rng.Hyperlinks.Add Anchor:=rng, Address:="https://doi.org/" & doi
            ' 移动到下一个匹配项
            rng.Collapse wdCollapseEnd
            rng.MoveStart wdCharacter, 1
        Loop
        
    End With
End Sub