(Excel) Backup Windows Current User / Personal Certificates to a .zip

Demonstrates how to backup the certificates in the Windows registry-based Current User certificate store (in the "Personal" Logical Store as seen in certmgr.msc), to a zip archive. Certificates having an exportable private key are exported to .pfx files. Certificates with no private key, or with a non-exportable private key, are exported to .cer files.

Obviously, this example only runs on Windows computers.

Download Excel Class Modules Chilkat Excel Class Modules

Dim certStore As Chilkat.CertStore
Set certStore = Chilkat.NewCertStore


readOnly = True

success = certStore.OpenCurrentUserStore(readOnly)
If (Not success) Then
    Debug.Print certStore.LastErrorText
    Exit Sub
End If


pfxPassword = "secret"


allSuccess = True

numSuccess = 0

Dim zip As Chilkat.Zip
Set zip = Chilkat.NewZip
success = zip.NewZip("qa_output/personalCerts.zip")

Dim certData As Chilkat.BinData
Set certData = Chilkat.NewBinData
Dim sbFilename As Chilkat.StringBuilder
Set sbFilename = Chilkat.NewStringBuilder

'  Iterate over the certificates in the Current User store.

numCerts = certStore.NumCertificates

i = 0
Do While i < numCerts

    Set cert = certStore.GetCertificate(i)
    Debug.Print "DN = "; cert.SubjectDN

    success = sbFilename.SetString("cert")
    success = sbFilename.AppendInt(i + 1)


    bHasPrivateKey = cert.HasPrivateKey()
    If ((bHasPrivateKey = True) And (cert.PrivateKeyExportable = True)) Then
        '  Export to a .pfx
        success = cert.ExportToPfxBd(pfxPassword,True,certData)
        If (success = True) Then
            success = sbFilename.Append(".pfx")
            Set entry = zip.AppendBd(sbFilename.GetAsString(),certData)

        End If

    Else
        '  Export to a .cer
        success = cert.ExportCertDerBd(certData)
        If (success = True) Then
            success = sbFilename.Append(".cer")
            Set entry = zip.AppendBd(sbFilename.GetAsString(),certData)

        End If

    End If

    If (success <> True) Then
        allSuccess = False
    Else
        numSuccess = numSuccess + 1
    End If

    i = i + 1
Loop

If (numSuccess > 0) Then
    success = zip.WriteZipAndClose()
    If (success <> True) Then
        Debug.Print zip.LastErrorText
        allSuccess = False
    End If

End If

Debug.Print "All success = "; allSuccess