you can try this:

Sub Click(Source As Button)
    On Error Goto err1
    Dim ws As New NotesUIWorkspace
    Dim Servername As String
    Dim hKFC As Long
    Dim session As New NotesSession
    Dim user As String
    Dim path As String
    
    path = session.GetEnvironmentString("KeyFileName",True)
    
    user = session.UserName
    
    Servername = "type the vault server name here"
    
    IDfilename = path
    
pwd:    
    Password = ws.Prompt(PROMPT_PASSWORD, "ID-Management - Password prompt", "Please enter the Notes ID password.","")
    
    ret = SECKFMOpen(hKFC, IDfilename, Password, SECKFM_open_All, 0, 0)
    
    If ret <> 0 Then Error 1212, "Error encountered - Please retry"
    
    ret = SECidfPut(user,Password,IDFilename,0,Cstr(Servername),0,0,0)
    
    If ret <> 0 Then Error 1212, "Error encountered - Please retry"
    
' Close the database to free its resources
    
    ret = NSFDbClose(hdb)
    
    ret = SECKFMClose(hKFC,SECKFM_close_WriteIdFile,0,0)
    
    If ret <> 0 Then Error 1212, "Error encountered - Please retry"
    Msgbox "ID Upload successful"
    Exit Sub
err1:
    Print Error & "-" & Erl
    Goto pwd
End Sub