Formatar CNPJ

Function FormataCNPJ(str_cnpj As String ) As String


On Error Goto erro


Dim cnpj_original,ponto,barra,ifem,esq,dire As String
Dim parte1,parte2,parte3,parte4,parte5 As String
Dim tamanho,posicao As Integer

cnpj_original = str_cnpj
ponto = "."
barra = "/"
ifem = "-"

'Retira os pontos, barra e ifem
While Instr(str_cnpj, ponto) > 0 Or Instr(str_cnpj, barra) > 0 Or Instr(str_cnpj, ifem) > 0
tamanho = Len(str_cnpj)
posicao = Instr(str_cnpj, ponto)
If (posicao = 0 ) Then
posicao = Instr(str_cnpj, barra)
End If
If (posicao = 0 ) Then
posicao = Instr(str_cnpj, ifem)
End If

esq = Left(Cstr(str_cnpj), posicao -1)
dire = Right(Cstr(str_cnpj),tamanho - (posicao))
FormataCNPJ = Cstr(esq)+Cstr(dire)

Wend

'Verifica se é apenas numerico e se tem o tamanho correto do cnpj (só com numeros)
If Not Isnumeric(str_cnpj) Or Len(str_cnpj) <> 14 Then
Msgbox "Formato invalido do CNPJ, digite apenas numeros",,"Aviso Sistema"
FormataCNPJ = cnpj_original
Exit Function
End If

'Formata o CNPJ
parte1 = Left(Cstr(str_cnpj),2)+Cstr(ponto)
parte2 = Mid(Cstr(str_cnpj),3,3)+Cstr(ponto)
parte3 = Mid(Cstr(str_cnpj),6,3)+Cstr(barra)
parte4 = Mid(Cstr(str_cnpj),9,4)+Cstr(ifem)
parte5 = Mid(Cstr(str_cnpj),13,2)

FormataCNPJ = Cstr(parte1)+Cstr(parte2)+Cstr(parte3)+Cstr(parte4)+Cstr(parte5)

sai:
Exit Function
erro:
Msgbox "Erro na função FormataCNPJ da biblioteca BibRetencaoImposto na linha " + Str$(Erl) + " do tipo " + Str$(Err) + ": " + Error$
FormataCNPJ = cnpj_original
Resume sai
End Function