G
Guille
Hi, i got the following problem:
When i try to acces to the GAL using the CDO component an error pops up:
ACCESS DENIED when i try to see the GAL contact dates.
When i use the Outlook 2003 it works withot a problem, but in the 2007
Outlook it gets me that error even when im using the same font
This is the font code. In this part "For Each objAddress In
objGAL.AddressEntries
" its when i get the problem in Outlook 2007.
Ill apreciate if u can give me an answer the soon as posible.
Guille
Const strServer = "MyServer"
Const strMailbox = "MyMailbox"
Dim objSession As New MAPI.Session
Dim objAdds As MAPI.AddressLists
Dim objAddress As MAPI.AddressEntry
Dim objGAL As MAPI.AddressList
Dim objFields As MAPI.Fields, objField As MAPI.Field
Dim Codigo_User As String
Dim strAddress As String
Dim cnxRRHH As New ADODB.Connection
Dim cnxRRHHCS As New ADODB.Connection
Dim cmdRRHH As New ADODB.Command
Dim cmdRRHHCS As New ADODB.Command
Dim rsRRHH As New ADODB.Recordset
Dim strLista As String
Dim strProfileInfo As String
cnxRRHH.Open glStrConexionRRHH
cnxRRHHCS.Open glStrConexionRRHHCS
cmdRRHH.ActiveConnection = cnxRRHH
cmdRRHHCS.ActiveConnection = cnxRRHHCS
rsRRHH.CursorType = adOpenStatic
rsRRHH.CursorLocation = adUseClient
strProfileInfo = strServer & vbLf & strMailbox
objSession.Logon , , False, False, , True, strProfileInfo
If objSession Is Nothing Then Exit Sub
lstContacto.Clear
strEntidadSolicita = ""
Set objAdds = objSession.AddressLists
Set objGAL = objAdds.Item("Lista global de direcciones")
pbarCarga.Min = 0
pbarCarga.Max = objGAL.AddressEntries.Count
pbarCarga.Value = 0
Me.Repaint
For Each objAddress In objGAL.AddressEntries
pbarCarga.Value = pbarCarga.Value + 1
Me.frmCarga.Repaint
If objAddress.DisplayType = CdoUser Or objAddress.DisplayType =
CdoRemoteUser Then
If InStr(1, Trim(objAddress.Name), " ", vbTextCompare) > 0 Then
'Identifica Entidad Solicitante
If Trim(Me.txtSolicita.Text) = Trim(objAddress.Name) Then
Set objFields = objAddress.Fields
strAddress = objFields.Item(972947486)
strEntidadSolicita = IIf(InStr(1, strAddress,
"scotiabank.com.pe"), "SBP", IIf(InStr(1, strAddress, "crediscotia.com.pe"),
"CSF", ""))
End If
If InStr(1, Me.txtBody.Text, objAddress.Name, vbTextCompare)
Codigo_User = objFields.Item(973078558) '973078558:
codigo nickname
If Val(Mid(Codigo_User, 2)) > 0 Then
strAddress = objFields.Item(972947486)
cmdRRHH.CommandText = "Select
Codigo,Ape_Pat,Ape_Mat,Nombre,Cod_Cdr,Cdr,puesto,des_pto " & _
"From dbo.V_Trabajador_General
Where cast(Codigo as numeric(10,0))=" & Val(Mid(Codigo_User, 2))
Set rsRRHH = cmdRRHH.Execute
If rsRRHH.BOF = False Or rsRRHH.EOF = False Then
strLista = objAddress.Name & " - " &
CStr(Val(rsRRHH("Cod_Cdr"))) & ":" & LCase(Trim(rsRRHH("Cdr"))) & " - " &
LCase(Trim(rsRRHH("des_pto")))
Else
cmdRRHHCS.CommandText = "Select
Codigo,Ape_Pat,Ape_Mat,Nombre,Cod_Cdr,Cdr,puesto,des_pto " & _
"From
dbo.V_Trabajador_General Where cast(Codigo as numeric(10,0))=" &
Val(Mid(Codigo_User, 2))
'If rsRRHH.State = 1 Then
' rsRRHH.Close
'End If
Set rsRRHH = cmdRRHHCS.Execute
If rsRRHH.BOF = False Or rsRRHH.EOF = False Then
strLista = objAddress.Name & " - " &
CStr(Val(rsRRHH("Cod_Cdr"))) & ":" & LCase(Trim(rsRRHH("Cdr"))) & " - " &
LCase(Trim(rsRRHH("des_pto")))
Else
strLista = objAddress.Name & " - " &
"000:OTROS - OTROS"
End If
End If
lstContacto.AddItem strLista & ":" & IIf(InStr(1,
strAddress, "scotiabank.com.pe"), "SBP", IIf(InStr(1, strAddress,
"crediscotia.com.pe"), "CSF", "OTRO"))
lstContacto.SetFocus
End If
End If
End If
End If
Next
When i try to acces to the GAL using the CDO component an error pops up:
ACCESS DENIED when i try to see the GAL contact dates.
When i use the Outlook 2003 it works withot a problem, but in the 2007
Outlook it gets me that error even when im using the same font
This is the font code. In this part "For Each objAddress In
objGAL.AddressEntries
" its when i get the problem in Outlook 2007.
Ill apreciate if u can give me an answer the soon as posible.
Guille
Const strServer = "MyServer"
Const strMailbox = "MyMailbox"
Dim objSession As New MAPI.Session
Dim objAdds As MAPI.AddressLists
Dim objAddress As MAPI.AddressEntry
Dim objGAL As MAPI.AddressList
Dim objFields As MAPI.Fields, objField As MAPI.Field
Dim Codigo_User As String
Dim strAddress As String
Dim cnxRRHH As New ADODB.Connection
Dim cnxRRHHCS As New ADODB.Connection
Dim cmdRRHH As New ADODB.Command
Dim cmdRRHHCS As New ADODB.Command
Dim rsRRHH As New ADODB.Recordset
Dim strLista As String
Dim strProfileInfo As String
cnxRRHH.Open glStrConexionRRHH
cnxRRHHCS.Open glStrConexionRRHHCS
cmdRRHH.ActiveConnection = cnxRRHH
cmdRRHHCS.ActiveConnection = cnxRRHHCS
rsRRHH.CursorType = adOpenStatic
rsRRHH.CursorLocation = adUseClient
strProfileInfo = strServer & vbLf & strMailbox
objSession.Logon , , False, False, , True, strProfileInfo
If objSession Is Nothing Then Exit Sub
lstContacto.Clear
strEntidadSolicita = ""
Set objAdds = objSession.AddressLists
Set objGAL = objAdds.Item("Lista global de direcciones")
pbarCarga.Min = 0
pbarCarga.Max = objGAL.AddressEntries.Count
pbarCarga.Value = 0
Me.Repaint
For Each objAddress In objGAL.AddressEntries
pbarCarga.Value = pbarCarga.Value + 1
Me.frmCarga.Repaint
If objAddress.DisplayType = CdoUser Or objAddress.DisplayType =
CdoRemoteUser Then
If InStr(1, Trim(objAddress.Name), " ", vbTextCompare) > 0 Then
'Identifica Entidad Solicitante
If Trim(Me.txtSolicita.Text) = Trim(objAddress.Name) Then
Set objFields = objAddress.Fields
strAddress = objFields.Item(972947486)
strEntidadSolicita = IIf(InStr(1, strAddress,
"scotiabank.com.pe"), "SBP", IIf(InStr(1, strAddress, "crediscotia.com.pe"),
"CSF", ""))
End If
If InStr(1, Me.txtBody.Text, objAddress.Name, vbTextCompare)
Set objFields = objAddress.Fields0 Then
Codigo_User = objFields.Item(973078558) '973078558:
codigo nickname
If Val(Mid(Codigo_User, 2)) > 0 Then
strAddress = objFields.Item(972947486)
cmdRRHH.CommandText = "Select
Codigo,Ape_Pat,Ape_Mat,Nombre,Cod_Cdr,Cdr,puesto,des_pto " & _
"From dbo.V_Trabajador_General
Where cast(Codigo as numeric(10,0))=" & Val(Mid(Codigo_User, 2))
Set rsRRHH = cmdRRHH.Execute
If rsRRHH.BOF = False Or rsRRHH.EOF = False Then
strLista = objAddress.Name & " - " &
CStr(Val(rsRRHH("Cod_Cdr"))) & ":" & LCase(Trim(rsRRHH("Cdr"))) & " - " &
LCase(Trim(rsRRHH("des_pto")))
Else
cmdRRHHCS.CommandText = "Select
Codigo,Ape_Pat,Ape_Mat,Nombre,Cod_Cdr,Cdr,puesto,des_pto " & _
"From
dbo.V_Trabajador_General Where cast(Codigo as numeric(10,0))=" &
Val(Mid(Codigo_User, 2))
'If rsRRHH.State = 1 Then
' rsRRHH.Close
'End If
Set rsRRHH = cmdRRHHCS.Execute
If rsRRHH.BOF = False Or rsRRHH.EOF = False Then
strLista = objAddress.Name & " - " &
CStr(Val(rsRRHH("Cod_Cdr"))) & ":" & LCase(Trim(rsRRHH("Cdr"))) & " - " &
LCase(Trim(rsRRHH("des_pto")))
Else
strLista = objAddress.Name & " - " &
"000:OTROS - OTROS"
End If
End If
lstContacto.AddItem strLista & ":" & IIf(InStr(1,
strAddress, "scotiabank.com.pe"), "SBP", IIf(InStr(1, strAddress,
"crediscotia.com.pe"), "CSF", "OTRO"))
lstContacto.SetFocus
End If
End If
End If
End If
Next