"runtime error 2147467259(80004005) invalid authorization specification"
any one plz help me.its very urgent.
fir ur refernce i paste my code here..
' Library :
' Program Utilities (util.dll)
'*****************************************
'Global Variable
'*****************************************
Option Explicit
' Action Mode
Public Enum EnumAct
actNon = 0 ' Perform Nothing
actAdd = 1 ' Add Mode
actEdit = 2 ' Edit Mode
actDel = 3 ' Delete Mode
actSave = 4 'Save
actCancel = 5 'Cancel
actRefresh = 7 'Refresh
actList = 9 'List
End Enum
' Query Mode
Public Enum EnumQry
qryNon = 0 ' Perform Nothing
qrySetTo = 1 ' Goto Mode
qryFilter = 2 ' Filter Mode
End Enum
Global UserID As String
Global UserLvl As String
Global FundCode As String
Global BranchCode As String
Global PgmPath As String
Global MsgPath As String
Global AppPath As String
Global ImgPath As String
Global DebugPrg As Boolean
Global PCnn As String
Global PAUsr As String
Global Pspwd As String
Global PCmpy As String
Global gProgramID As String
' Account Position
Global posAcc As Integer
Global posPlan As Integer
Global posFCd As Integer
Global posDgt As Integer
Global AccFmt As String
Global AccMask As String
' Colour - Header, Detail, HGrid
Global colorHdr As ColorConstants
Global colorDtl As ColorConstants
Global colorGrid As ColorConstants
Global cn As New ADODB.Connection
Public Sub Main()
Dim colorTmp As String
Dim a As New clsEncryptDecrypt
If AppLoaded Then
Exit Sub
End If
' ** Registry Value **
' Connection
PCnn = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "CnnUH")
PAUsr = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "Svrusr")
Pspwd = util.GetString(util.HKEY_LOCAL_MACHINE, "software\rbs\Toms", "Svrpwd")
If Trim(Pspwd) <> "" Then
Pspwd = a.DecryptText(Trim(Pspwd))
End If
Call GetCnn
' get company title
PCmpy = util.GetString(util.HKEY_LOCAL_MACHINE, "software\rbs\Toms", "Company")
' Account format
AccFmt = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "AccFmt")
AccMask = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "AccMask")
posAcc = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posAcc")
posPlan = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posPlan")
posFCd = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posFCd")
posDgt = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "posDgt")
colorHdr = Val(util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "colorHdr"))
colorDtl = Val(util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "colorDtl"))
colorGrid = Val(util.GetString(util.HKEY_LOCAL_MACHINE, "Software\rbs\Toms", "colorGrid"))
DebugPrg = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\RBS\Setting", "DebugPrg") = "Y"
PgmPath = util.GetString(util.HKEY_LOCAL_MACHINE, "Software\RBS\Toms", "Program Path")
'If DebugPrg Then
' AppPath = App.Path & "\.."
'Else
' AppPath = App.Path
'End If
' Infomation file values (.ini)
AppPath = PgmPath & "\UH"
'AppPath = PgmPath & "\uh new" 'temporary - testing
MsgPath = PgmPath & "\UHMsg.ini"
ImgPath = PgmPath & "\Qimg"
' Parameter Values
UserID = GetPara(Command, "User") ' util.StrBlock(Command, 1, "|")
FundCode = GetPara(Command, "Fund") ' util.StrBlock(Command, 2, "|")
BranchCode = GetPara(Command, "Branch") ' util.StrBlock(Command, 3, "|")
gProgramID = GetPara(Command, "Program")
Call StartProgram
End Sub
Public Function Ppara()
Ppara = " ;User " & Trim(UserID) & " ;Fund " & Trim(FundCode) & " ;Branch " & Trim(BranchCode) & " ;Program " & Trim(gProgramID)
End Function
Public Function GetCnn()
If cn.State = adStateOpen Then GoTo EndCnn
'Connection
cn.Open PCnn, Trim$(PAUsr), Trim$(Pspwd)
cn.CommandTimeout = 0
cn.CursorLocation = adUseClient
EndCnn:
End Function
Private Function AppLoaded() As Boolean
Const scMSg = " is already running, only one instance of program is allowed."
AppLoaded = False
If App.PrevInstance Then
AppLoaded = True
MsgBox App.ProductName & scMSg, vbCritical
Exit Function
End If
End Function
Public Function GetPara(sPara, sKey As String) As String
Dim s As String
Dim s2 As String
Dim Pos1 As Integer
Dim Pos2 As Integer
s = ";" & UCase(sKey)
s2 = UCase(sPara) & ";"
Pos1 = 1
Pos1 = InStr(Pos1, s2, s)
If Pos1 = 0 Then
GetPara = ""
Exit Function
End If
Pos2 = Pos1 + 1
Pos2 = InStr(Pos2, s2, ";")
GetPara = Trim(Mid(sPara, Pos1 + Len(s), Pos2 - Pos1 - Len(s)))
End Function
Public Sub RbsMask(MaskAcc As RBSTextNumEx, RBSAcc As String, MaskType As Integer)
Dim TmpAcc As String
Dim X As Integer
Dim Y As Integer
Dim Proceed As Boolean
TmpAcc = " "
' Mask type = 0 (UnMask) = 1 (Mask) = 2 (Unmask - wsAcc only)
If Trim$(MaskAcc.Text) = "" Then
MaskAcc.Text = " "
RBSAcc = MaskAcc.Text
Exit Sub
End If
X = 1
If MaskType <> 1 Then ' UnMask
Proceed = False
'Do While X <= 14
Do While X <= 16
If Mid(MaskAcc.Text, X, 1) = "-" Then Proceed = True
X = X + 1
Loop
Else
Proceed = True
'Do While X <= 14
Do While X <= 16
If Mid(MaskAcc.Text, X, 1) = "-" Then Proceed = False
X = X + 1
Loop
End If
If Proceed = False Then
If MaskType <> 1 Then RBSAcc = MaskAcc.Text
Exit Sub
End If
RBSAcc = MaskAcc.Text
X = 1
Y = 1
If MaskType <> 1 Then ' UnMask
'Do While X <= 14
Do While X <= 16
If Mid(AccFmt, X, 1) <> "-" Then
Mid(TmpAcc, Y, 1) = Mid(MaskAcc.Text, X, 1)
Y = Y + 1
End If
X = X + 1
Loop
RBSAcc = TmpAcc
Else ' Mask
'Do While X <= 14
Do While X <= 16
If Mid(AccFmt, X, 1) <> "-" Then
Mid(TmpAcc, X, 1) = Mid(MaskAcc.Text, Y, 1)
Y = Y + 1
Else
Mid(TmpAcc, X, 1) = "-"
End If
X = X + 1
Loop
End If
If MaskType <> 2 Then
MaskAcc.Text = TmpAcc
End If
End Sub
Public Sub RBSMsg(ErrType As String, MsgID As String, Focus As Object, MsgType As Integer)
Select Case MsgType
Case 1 ' validation check
MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
vbApplicationModal + vbCritical, "Validation Check"
Case 2 ' record check
MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
vbApplicationModal + vbOKOnly, "Record Check"
Case 3 ' Prompt check
MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
vbApplicationModal + vbOKOnly, "Prompt Check"
Case 4 ' Database error check
MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
vbApplicationModal + vbCritical, "DataBase error"
Case 5 ' Database busy
MsgBox util.GetINI(ErrType, MsgID, MsgPath), _
vbApplicationModal + vbCritical, "Database busy"
End Select
If Focus.Enabled Then Focus.SetFocus
End Sub
iam getting error line i underlined.please any one suggest me.its very urgent...