Validar Cnpj

[creko]

ae pessoal como eu posso validar um cnpj ? saber se ele é valido ou não !

fiz uma busca aqui no forum mas não achei !!

falou

obrigado

[Fabson]

Public Function ValidarCPF(CPF As String) As Boolean

Dim Soma As Integer

Dim Resto As Integer

Dim i As Integer

'Valida argumento

CPF = Mid(CPF, 1, 3) & Mid(CPF, 5, 3) & Mid(CPF, 9, 3) & Mid(CPF, 13, 2)

If Len(Trim(CPF)) <> 11 Then

ValidarCPF = False

Exit Function

End If

Soma = 0

For i = 1 To 9

Soma = Soma + Val(Mid$(CPF, i, 1)) * (11 - i)

Next i

If Soma = 0 Then

ValidarCPF = False

Exit Function

End If

Resto = 11 - (Soma - (Int(Soma / 11) * 11))

If Resto = 10 Or Resto = 11 Then Resto = 0

If Resto <> Val(Mid$(CPF, 10, 1)) Then

ValidarCPF = False

Exit Function

End If

Soma = 0

For i = 1 To 10

Soma = Soma + Val(Mid$(CPF, i, 1)) * (12 - i)

Next i

Resto = 11 - (Soma - (Int(Soma / 11) * 11))

If Resto = 10 Or Resto = 11 Then Resto = 0

If Resto <> Val(Mid$(CPF, 11, 1)) Then

ValidarCPF = False

Exit Function

End If

ValidarCPF = True

End Function

'---------------------------------------------------------------------------------

Public Function ValidarCNPJ(cgc As String) As Boolean

Dim retorno, a, j, i, d1, d2, pos

Dim ncgc, Numero As String

For i = 1 To 18

Numero = Mid(cgc, i, 1)

pos = InStr("1234567890", Numero)

If pos <> 0 Then ncgc = (ncgc + Numero)

Next i

cgc = ncgc

If Len(cgc) = 8 And Val(cgc) > 0 Then

a = 0

j = 0

d1 = 0

For i = 1 To 7

a = Val(Mid(cgc, i, 1))

If (i Mod 2) <> 0 Then

a = a * 2

End If

If a > 9 Then

j = j + Int(a / 10) + (a Mod 10)

Else

j = j + a

End If

Next i

d1 = IIf((j Mod 10) <> 0, 10 - (j Mod 10), 0)

If d1 = Val(Mid(cgc, 8, 1)) Then

ValidarCNPJ = True

Else

ValidarCNPJ = False

End If

Else

If Len(cgc) = 14 And Val(cgc) > 0 Then

a = 0

i = 0

d1 = 0

d2 = 0

j = 5

For i = 1 To 12 Step 1

a = a + (Val(Mid(cgc, i, 1)) * j)

j = IIf(j > 2, j - 1, 9)

Next i

a = a Mod 11

d1 = IIf(a > 1, 11 - a, 0)

a = 0

i = 0

j = 6

For i = 1 To 13 Step 1

a = a + (Val(Mid(cgc, i, 1)) * j)

j = IIf(j > 2, j - 1, 9)

Next i

a = a Mod 11

d2 = IIf(a > 1, 11 - a, 0)

If (d1 = Val(Mid(cgc, 13, 1)) And d2 = Val(Mid(cgc, 14, 1))) Then

ValidarCNPJ = True

Else

ValidarCNPJ = False

End If

Else

ValidarCNPJ = False

End If

End If

End Function

até mais

[creko]

Valeu !!

obrigado

por mim pode fechar !

[Alexandre_Ribeiro]

Cara,

você tem o codigo de validação de e-mail ?

Grato,

Alexandre.

[Fabson]

Public Function ValidEMail(sEMail As String) As Boolean

Dim nCharacter As Integer

Dim Count As Integer

Dim sLetra As String

If Len(sEMail) < 5 Then

ValidEMail = False

MsgBox "O E-Mail Digitado tem menos de 5 caracteres!!!", vbExclamation, "Atenção"

Exit Function

End If

For nCharacter = 1 To Len(sEMail)

If Mid(sEMail, nCharacter, 1) = "@" Then

Count = Count + 1

End If

Next

If Count <> 1 Then

ValidEMail = False

MsgBox "O nº de arrobas (@) do E-Mail é inválido!!!", vbExclamation, "Atenção"

Exit Function

Else

If InStr(sEMail, "@") = 1 Then

ValidEMail = False

MsgBox "O E-Mail foi iniciado com uma arroba (@)!!!", vbExclamation, "Atenção"

Exit Function

ElseIf InStr(sEMail, "@") = Len(sEMail) Then

ValidEMail = False

MsgBox "O E-Mail termina com uma arroba (@)!!!", vbExclamation, "Atenção"

Exit Function

End If

End If

nCharacter = 0

Count = 0

For nCharacter = 1 To Len(sEMail)

If Mid(sEMail, nCharacter, 1) = "." Then

Count = Count + 1

End If

Next

If Count < 1 Then

ValidEMail = False

MsgBox "O E-Mail é inválido, pois não contém pontos (.)!!!", vbExclamation, "Atenção"

Exit Function

Else

If InStr(sEMail, ".") = 1 Then

ValidEMail = False

MsgBox "O E-Mail foi iniciado com um ponto (.)!!!"

Exit Function

ElseIf InStr(sEMail, ".") = Len(sEMail) Then

ValidEMail = False

MsgBox "O E-Mail termina com um ponto (.)!!!"

Exit Function

ElseIf InStr(InStr(sEMail, "@"), sEMail, ".") = 0 Then

ValidEMail = False

MsgBox "O E-Mail não tem nenhum ponto (.) após a arroba (@)!!!", vbExclamation, "Atenção"

Exit Function

End If

End If

nCharacter = 0

Count = 0

If InStr(sEMail, "..") > InStr(sEMail, "@") Then

ValidEMail = False

MsgBox "O E-Mail contém pontos consecutivos (..) após o arroba (@)!!!", vbExclamation, "Atenção"

Exit Function

End If

For nCharacter = 1 To Len(sEMail)

sLetra = Mid$(sEMail, nCharacter, 1)

If Not (LCase(sLetra) Like "[a-z]" Or sLetra = _

"@" Or sLetra = "." Or sLetra = "-" Or _

sLetra = "_" Or IsNumeric(sLetra)) Then

ValidEMail = False

MsgBox "Foi digitado um caracter inválido no E-Mail!!!", vbExclamation, "Atenção"

Exit Function

End If

Next

If Right$(sEMail, 1) = "." Then

ValidEMail = False

MsgBox "E-Mail não Pode Terminar Com Ponto (.) ..!!!", vbExclamation, "Atenção"

End If

nCharacter = 0

ValidEMail = True

End Function