Option Explicit
Private Declare Function VaultOpenVault Lib "vaultcli.dll" (ByRef VaultGuid As GUID, ByVal dwFlags As Long, ByRef VaultHandle As Long) As Long
Private Declare Function VaultCloseVault Lib "vaultcli.dll" (ByRef VaultHandle As Long) As Long
Private Declare Function VaultEnumerateItems Lib "vaultcli.dll" (ByVal VaultHandle As Long, ByVal dwFlags As Long, ByRef ItemsCount As Long, ByRef Items As Long) As Long
Private Declare Function VaultGetItem Lib "vaultcli.dll" (ByVal VaultHandle As Long, pSchemaId As GUID, ByVal pResource As Long, ByVal pIdentity As Long, ByVal pPackageSid As Long, ByVal hwndOwner As Long, ByVal dwFlags As Long, ppItem As Long) As Long
Private Declare Function VaultFree Lib "vaultcli.dll" (ByVal ppItem As Long) As Long

Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long


Private Enum VAULT_SCHEMA_ELEMENT_ID
 ElementId_Illegal = 0
 ElementId_Resource = 1
 ElementId_Identity = 2
 ElementId_Authenticator = 3
 ElementId_Tag = 4
 ElementId_PackageSid = 5
 ElementId_AppStart = &H64
 ElementId_AppEnd = &H2710
End Enum

Private Enum VAULT_ELEMENT_TYPE
 ElementType_Boolean = 0
 ElementType_Short = 1
 ElementType_UnsignedShort = 2
 ElementType_Integer = 3
 ElementType_UnsignedInteger = 4
 ElementType_Double = 5
 ElementType_Guid = 6
 ElementType_String = 7
 ElementType_ByteArray = 8
 ElementType_TimeStamp = 9
 ElementType_ProtectedArray = 10
 ElementType_Attribute = 11
 ElementType_Sid = 12
 ElementType_Last = 13
 ElementType_Undefined = -1
End Enum

Private Type FILETIME
 dwLowDateTime As Long
 dwHighDateTime As Long
End Type

Private Type VAULT_VARIANT
 veType As VAULT_ELEMENT_TYPE
 Unknown As Long
 lpString As Long
End Type

Private Type VAULT_ITEM_ELEMENT
 SchemaElementId As VAULT_SCHEMA_ELEMENT_ID
 Unknown As Long
 ItemValue As VAULT_VARIANT
End Type

Private Type GUID
 Data1 As Long
 Data2 As Integer
 Data3 As Integer
 Data4(0 To 7) As Byte
End Type

Private Type VAULT_ITEM_W8
 SchemaId As GUID
 pszCredentialFriendlyName As Long
 pResourceElement As Long ' VAULT_ITEM_ELEMENT
 pIdentityElement As Long ' VAULT_ITEM_ELEMENT
 pAuthenticatorElement As Long ' VAULT_ITEM_ELEMENT
 pPackageSid As Long ' VAULT_ITEM_ELEMENT
 LastModified As FILETIME
 dwFlags As Long
 dwPropertiesCount As Long
 pPropertyElements As Long ' VAULT_ITEM_ELEMENT
End Type

Private Type VAULT_ITEM_W7
 SchemaId As GUID
 pszCredentialFriendlyName As Long
 pResourceElement As Long ' VAULT_ITEM_ELEMENT
 pIdentityElement As Long ' VAULT_ITEM_ELEMENT
 pAuthenticatorElement As Long ' VAULT_ITEM_ELEMENT
 LastModified As FILETIME
 dwFlags As Long
 dwPropertiesCount As Long
 pPropertyElements As Long ' VAULT_ITEM_ELEMENT
End Type

Const WEB_CREDENTIALS As String = "{4BF4C442-9B8A-41A0-B380-DD4A704DDB28}"
Const VAULT_ENUMERATE_ALL_ITEMS = 512

Public Function GetVaultCredentials() As String
 Dim tGUID As GUID
 Dim hVault As Long
 Dim ItemsCount As Long, i As Long
 Dim Items As Long
 Dim VI_W8() As VAULT_ITEM_W8
 Dim dwError As Long
 Dim ppCredentials As Long 'VAULT_ITEM_W8
 Dim tVIE As VAULT_ITEM_ELEMENT
 Dim sResult As String
 Dim tItemVault As VAULT_ITEM_W8

 CLSIDFromString StrPtr(WEB_CREDENTIALS), tGUID

 If VaultOpenVault(tGUID, 0, hVault) <> 0 Then Exit Function

 Call VaultEnumerateItems(hVault, 0, ItemsCount, Items)
 ReDim VI_W8(ItemsCount - 1)
 CopyMemory VI_W8(0), ByVal Items, Len(VI_W8(0)) * ItemsCount

 For i = 0 To ItemsCount - 1
 If VI_W8(i).dwPropertiesCount <> 0 Then

 dwError = VaultGetItem(hVault, VI_W8(i).SchemaId, VI_W8(i).pResourceElement, VI_W8(i).pIdentityElement, 0&, 0&, 0&, ppCredentials)

 If dwError = 0 Then
 sResult = sResult & "Account: " & PtrToString(VI_W8(i).pszCredentialFriendlyName)

 CopyMemory tVIE, ByVal VI_W8(i).pResourceElement, Len(tVIE)

 sResult = sResult & " URL: " & PtrToString(tVIE.ItemValue.lpString)

 CopyMemory tVIE, ByVal VI_W8(i).pIdentityElement, Len(tVIE)

 sResult = sResult & " User: " & PtrToString(tVIE.ItemValue.lpString)

 CopyMemory tItemVault, ByVal ppCredentials, Len(tItemVault)
 CopyMemory tVIE, ByVal tItemVault.pAuthenticatorElement, Len(tVIE)

 sResult = sResult & " Pass: " & PtrToString(tVIE.ItemValue.lpString) & vbCrLf

 VaultFree (ppCredentials)
 ppCredentials = 0
 End If
 End If
 Next

 VaultCloseVault (hVault)

 GetVaultCredentials = sResult
End Function

Private Function PtrToString(lpwString As Long) As String
 Dim Buffer() As Byte
 Dim nLen As Long
 If lpwString Then
 nLen = lstrlenW(lpwString) * 2
 If nLen Then
 ReDim Buffer(0 To (nLen - 1)) As Byte
 CopyMemory Buffer(0), ByVal lpwString, nLen
 PtrToString = Buffer
 End If
 End If
End Function

Private Sub Form_Load()
 Text1.Text = GetVaultCredentials
End Sub