You can use a common minimum authority profile to perform the initial connection and then call the QSYSETPT API to adopt a specific profile using the token.
cnn = New ADODB.Connection
cnn.Open "Provider=IBMDA400;Data Source=AS400SERVERNAME;Force Translate=0", USER, PASS
cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
cmd.CommandText = "{{CALL QSYSETPT(?,?)}}"
cmd.Parameters.Append
cmd.CreateParameter(, adBinary, adParamInput, 32, token)
cmd.Parameters.Append
cmd.CreateParameter(, adInteger, adParamInputOutput, 4, 0)
cmd.Execute