Função para adicionar caracter a uma string informando a posição

AdicionaCaracter("String",4, ".")

Function AdicionaCaracter(valor As String,qtdToAddCaracter As Integer, caracter As String) As String

Dim texto As String, novaString As String
Dim ponto As Integer, total As Integer, cont As Integer
cont = 0

texto = valor
ponto = qtdToAddCaracter
total = Len(valor)

While cont < total
novaString = novaString & caracter & Cstr(Mid(texto,cont+1,4))
cont = cont+4
Wend

AdicionaCaracter = Right$(novaString,Len(novaString)-1)

End Function