Exemplo que lê o repositório pessoal do usuário. Altere as constantes a vontade para ler qualquer outro repositório de qualquer outro local.
Baixe e instale o CAPICOM
microsoft.com/pt-br/download/details.aspx?id=3207
Habilite a referência CAPICOM v2.1 Type Library
Em um módulo global cole e execute
Baixe e instale o CAPICOM
microsoft.com/pt-br/download/details.aspx?id=3207
Habilite a referência CAPICOM v2.1 Type Library
Em um módulo global cole e execute
- Código:
Sub fncInfoCertificado()
' Baixe, instale o CAPICOM e habilite a referência CAPICOM v2.1 Type Library
' microsoft.com/pt-br/download/details.aspx?id=3207
On Error GoTo trataErro
Const REPOSITORIO_PESSOAL As String = "My"
Dim objStore As CAPICOM.Store
Dim objCertificados As CAPICOM.Certificates
Dim objCertificado
Set objStore = New Store
Set objCertificados = New CAPICOM.Certificates
Call objCertificados.Clear
Call objStore.Open(CAPICOM_CURRENT_USER_STORE, REPOSITORIO_PESSOAL, CAPICOM_STORE_OPEN_READ_ONLY)
For Each objCertificado In objStore.Certificates
Call objCertificados.Add(objCertificado)
Next objCertificado
If objCertificados.Count = 0 Then
Call MsgBox("Nenhum certificado encontrado no repositório indicado.")
Else
Set objCertificado = objCertificados.Select("Certificados Digitais", "Selecione", False)
Call MsgBox("Nome: " & objCertificado(1).GetInfo(CAPICOM_CERT_INFO_SUBJECT_SIMPLE_NAME) & vbNewLine & _
"Emitido em: " & objCertificado(1).ValidFromDate & vbNewLine & _
"Válido até: " & objCertificado(1).ValidToDate)
End If
sair:
Set objCertificado = Nothing
Set objCertificados = Nothing
Set objStore = Nothing
Exit Sub
trataErro:
If Err.Number > 0 Then
Call MsgBox("Erro VBA: " & Err.Description)
ElseIf Err.Number = -2138568446 Then
Call MsgBox("Operação cancelada.")
Else
Call MsgBox("Erro CAPICOM: " & Err.Number)
End If
Resume sair
End Sub