Код выдает ошибку. Что неправильно?

'Объявляем массив общим для всего модуля
Dim aName() As String
Sub test()
    Dim rng As Range
    Set rng = ActiveDocument.Range(Start:=0, End:=0)
    Call FindBookmarkNameByStart (rng)
End Sub

'Вместо функции теперь можно использовать процедуру, которая будет изменять глобальную переменную
Private Sub FindBookmarkNameByStart(rng As Range)
    Dim i As Long
    Dim j As Long
    For i = 1 To rng.Bookmarks.Count
        If rng.Bookmarks(i).Range.Start = rng.Start Then
            j = j + 1
            ReDim Preserve aName(1 To j)
            aName(j) = rng.Bookmarks(i).Name
            Debug.Print "Text Find: " & rng.Bookmarks(i).Range.Text
        End If
    Next i
End Sub

Sub test()
    Dim rng As Range
    Dim aName()'Объявляем массив как Variant
    Set rng = ActiveDocument.Range(Start:=0, End:=0)
    aName = FindBookmarkNameByStart(rng)     <-- Error: Can't assign to array
End Sub

Private Function FindBookmarkNameByStart(rng As Range) As Variant
    Dim i As Long
    Dim j As Long
    Dim aName() As String
    For i = 1 To rng.Bookmarks.Count
        If rng.Bookmarks(i).Range.Start = rng.Start Then
            j = j + 1
            ReDim Preserve aName(1 To j)
            aName(j) = rng.Bookmarks(i).Name
            Debug.Print "Text Find: " & rng.Bookmarks(i).Range.Text
        End If
    Next i
    FindBookmarkNameByStart = aName
End Function

WordApp.Selection

Dim WordApp As Word.Application 
Dim newDoc As Word.Document 

Set WordApp = New Word.Application
WordApp.Visible = True

Set newDoc = Documents.Add("D:\Dov.doc")
DataProp = DTPicker1

With newDoc.Range.Find
  .Text = "/Дата документа/"
  .Replacement.Text = DataProp
  .Execute Replace:=WordApp.WdReplace.wdReplaceAll
End With