|
Hola Javier, buenos días y gracias.
Te pego lo que he colocado en mi formulario3 de tu código.
Private Sub Form_Open(Cancel As Integer)
'En el FORMULARIO de entrada en el evento al abrir (On Open)
pon esto
If
funCrearZonaConfianza = True Then
MsgBox
"Ok se ha creado una nueva zona de confianza", vbInformation,
"Zona de Confianza"
Else
MsgBox
"No es necesario crear la zona de confianza", vbExclamation,
"Zona de Confianza"
End If
End Sub
A continuación pego donde empieza la historia. Que la he
resumido al principio de donde comienza el código para empezar la partida. Así
no tengo que esperar a que se corra el resto de código (esto debido a los
problemas que me daba, por eso subir aquí la apertura del archivo con el número
41.)
Private Sub Comando0_Click()
'C:\Users\Usuario\Desktop\DE VICENTE
'"C:\Users\Usuario\Desktop\DE
VICENTE\reunion.docx" 'CORRECTO, FUNCIONA PERFECTAMENTE Y SE ABRE
'C:\Users\Usuario\Desktop\buho
'C:\Users\Usuario\Documents\Grabaciones de sonido\1.M4A"
'CORRECTO:Application.FollowHyperlink
"C:\Users\Usuario\Desktop\DE VICENTE\ARCHIVOSVOZbolasBINGO\" & 41
& ".M4A" '2.M4A"
'Dim RetVal
'RetVal = Shell("C:\Users\Usuario\Desktop\DE
VICENTE\ARCHIVOSVOZbolasBINGO\HOLA.DOCX", 1)
'Exit Sub
Application.FollowHyperlink
"C:\Users\Usuario\Desktop\DE VICENTE\ARCHIVOSVOZbolasBINGO\" & 41
& ".M4A" ''''aqui es donde avisa
Exit Sub
Por último vuelvo a pegar tu código, con los Msgbox que yo
me he puesto para ver si entra a todas las funciones.
Option Compare Database
Option Explicit
Const cPrefijo As String =
"HKEY_CURRENT_USER\Software\Microsoft\Office\"
Const cSufijo As String = "\Access\Security\Trusted
Locations\Location"
' rem Fin Constantes++++++
'Public Function funTest()
'msgbox "AQUI NO NECESITO ENTRAR. SE COLOCARÁ EN EL
FORMULARIO SEGÚN SE INDICA AL FINAL DE ESTE MODULO"
' If
funCrearZonaConfianza = True Then
' MsgBox
"Ok se ha creado una nueva zona de confianza", vbInformation,
"Zona de Confianza"
' Else
' MsgBox
"No es necesario crear la zona de confianza", vbExclamation,
"Zona de Confianza"
' End If
'
'End Function
Public Function funCrearZonaConfianza() As Boolean
'---------------------------------------------------------------------------------------
' Date :
23/01/2010
' Author : Javier
Gomez (Javier.Mil)
' WEB :
http://www.accessdemo.info
' Procedure : funCrearZonaConfianza
' Purpose : Crea
Zona de Confianza para Access 2007 , 2010 , 2013 , 2017 , 2019 utilizando
"LOCATION (n)"
'---------------------------------------------------------------------------------------
On Error GoTo
Err_Local
MsgBox "estoy entrando en la funcion
Crearconfianza"
Dim objWshShell As
Object
Dim intX As
Integer
Dim
strVersionAccess As String
Set objWshShell =
CreateObject("Wscript.Shell")
strVersionAccess =
SysCmd(acSysCmdAccessVer)
If
strVersionAccess = "12.0" Or strVersionAccess = "14.0" Or
strVersionAccess = "15.0" Or strVersionAccess = "16.0" Or
strVersionAccess = "17.0" Then
Rem Access
2007 , Access 2010 , Access 2013 , Access 2016 , Access 2019
If
funBuscarZonaConfianza <> CurrentProject.Path & "\" Then
intX =
funPrimerLocationVacio
objWshShell.RegWrite cPrefijo & strVersionAccess & cSufijo &
intX & "\AllowNetworkLocations", 1, "REG_DWORD"
objWshShell.RegWrite cPrefijo & strVersionAccess & cSufijo &
intX & "\AllowSubfolders", 1, "REG_DWORD"
objWshShell.RegWrite cPrefijo & strVersionAccess & cSufijo &
intX & "\Date", Format(Now(), "mm/dd/yyyy hh:mm")
objWshShell.RegWrite cPrefijo & strVersionAccess & cSufijo &
intX & "\Description", "Mi nueva zona de confianza"
objWshShell.RegWrite cPrefijo & strVersionAccess & cSufijo &
intX & "\Path", CurrentProject.Path & "\"
funCrearZonaConfianza = True
Else
funCrearZonaConfianza = False
End If
End If
Close_Local:
Set objWshShell =
Nothing
Exit_Local:
On Error GoTo 0
Exit Function
Err_Local:
funCrearZonaConfianza
= False
MsgBox
Err.Description, vbCritical, "Error N°:
" & Err.Number
Resume Exit_Local
End Function
Private Function funBuscarZonaConfianza() As String
'---------------------------------------------------------------------------------------
' Date :
23/01/2010
' Author : Javier
Gomez (Javier.Mil)
' WEB :
http://www.accessdemo.info
' Procedure : funBuscarZonaConfianza
' Purpose : Busca si
existe la Zona de Confianza
'---------------------------------------------------------------------------------------
On Error Resume
Next
MsgBox "estoy entrando en la funcion
Buscarconfianza"
Dim objWshShell As
Object
Dim strTemp As
String
Dim intX As
Integer
Dim
strVersionAccess As String
Set objWshShell =
CreateObject("Wscript.Shell")
strVersionAccess =
SysCmd(acSysCmdAccessVer)
For intX = 0 To
999
strTemp =
objWshShell.RegRead(cPrefijo & strVersionAccess & cSufijo & intX
& "\Path")
If strTemp =
CurrentProject.Path & "\" Then
funBuscarZonaConfianza = strTemp
Exit For
End If
Next intX
Set objWshShell =
Nothing
End Function
Private Function funPrimerLocationVacio() As Integer
'---------------------------------------------------------------------------------------
' Date :
23/01/2010
' Author : Javier
Gomez (Javier.Mil)
' WEB :
http://www.accessdemo.info
' Procedure : funPrimerLocationVacio
' Purpose : Busca el
primer Location vacio o libre
'---------------------------------------------------------------------------------------
On Error Resume
Next
MsgBox "estoy entrando en la funcion vacio"
Dim objWshShell As
Object
Dim strTemp As String
Dim intX As
Integer
Dim
strVersionAccess As String
Set objWshShell =
CreateObject("Wscript.Shell")
strVersionAccess =
SysCmd(acSysCmdAccessVer)
For intX = 0 To
999
strTemp =
""
strTemp = objWshShell.RegRead(cPrefijo
& strVersionAccess & cSufijo & intX & "\Path")
If strTemp =
"" Then
funPrimerLocationVacio = intX
Exit For
End If
Next intX
Set objWshShell =
Nothing
End Function
Y todo corre perfecto, pero, persisten los avisos de Microsoft Office.
Incluso yo he ido a donde están las ubicaciones de confianza y veo la que crea tu código con mi ruta. Yo también la cree ayer y hoy la eliminado antes de correr tu código. Estas son las carpetas que hay, ahora mismo, en "Ubicaciones de confianza": C:\Users\Usuario\Desktop\DE VICENTE\ 'Creada por tu código hoy mismo. Incluso está marcada que las subcarpetas también son de confianza. C:\Users\Usuario\Desktop\'Creada por el sistema el 03/04/2018. 'Digo sistema, porque yo no la he creado en ningún momento. 'Además está marcada Permitir ubicaciones de confianza que estén en la red (no recomendado). Bueno, esto anterior, tras verlo ahora me toca replantearme si hay algún virus o algo que esté actuando en mi PC. C:\Program Files (x86)\Microsoft Office\Office12\ACCWIZ\'Esta no lleva fecha de creación.'A estas alturas, se supone que si esto es de confianza y que si la anterior también, la que crea tu código era innecesaria, toda vez que si las subcarpetas del Escritorio (Desktop) son de confianza.... al menos así lo entiendo yo. No se decir mas. Saludos y gracias otra vez.
------------- Gracias
|