Option Explicit 
' Funciones API para manejar el registro 
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, _
            ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, _
            ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _
            phkResult As Long, lpdwDisposition As Long) As Long 
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, _
            ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, _
            phkResult As Long) As Long 
Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _
            ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, _
            ByVal lpValue As String, ByVal cbData As Long) As Long 
Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _
            ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
            ByVal cbData As Long) As Long 

' Constantes para manejar el registro 
Public Const REG_SZ As Long = 1 
Public Const REG_DWORD As Long = 4 
Public Const HKEY_CLASSES_ROOT = &H80000000 
Public Const HKEY_CURRENT_USER = &H80000001 
Public Const HKEY_LOCAL_MACHINE = &H80000002 
Public Const HKEY_USERS = &H80000003 
Public Const KEY_ALL_ACCESS = &H3F 
Public Const REG_OPTION_NON_VOLATILE = 0 

' Constantes de posibles errores del registro 
Public Const ERROR_NONE = 0 
Public Const ERROR_BADDB = 1 
Public Const ERROR_BADKEY = 2 
Public Const ERROR_CANTOPEN = 3 
Public Const ERROR_CANTREAD = 4 
Public Const ERROR_CANTWRITE = 5 
Public Const ERROR_OUTOFMEMORY = 6 
Public Const ERROR_INVALID_PARAMETER = 7 
Public Const ERROR_ACCESS_DENIED = 8 
Public Const ERROR_INVALID_PARAMETERS = 87 
Public Const ERROR_NO_MORE_ITEMS = 259

Public Sub AsociarTipoArchivos(ByVal sExtension As String, ByVal sNombreApp As String, _
                   ByVal sDescripcionDocumento As String, ByVal sPathAplicacion As String) 
   ' Las asociaciones se guardan en  HKEY_CLASSES_ROOT. 

   ' Comprobamos si se ha incluido el punto 
   If Not Left$(sExtension, 1) = "." Then sExtension = "." & sExtension 

   ' Creamos la clave en el registro 
   CreateNewKey sExtension, HKEY_CLASSES_ROOT 

   ' Añadimos al registro la descripción del documento para que pueda abrirse 
   SetKeyValue sExtension, "", sNombreApp & ".Document", "REG_SZ" 

   ' Creamos un valor para que windows sepa que aplicación debe abrir 
   CreateNewKey sNombreApp & ".Documentshellopencommand", HKEY_CLASSES_ROOT 

   ' Este valor es el que muestra el explorador de windows 
   SetKeyValue sNombreApp & ".Document", "", sDescripcionDocumento, REG_SZ 

   ' Ponemos el path de la aplicación para que windows pueda abrirlo 
   SetKeyValue sNombreApp & ".Documentshellopencommand", "", sPathAplicacion, REG_SZ 
End Sub 

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long 
   Dim nValue As Long 
   Dim sValue As String 
   Select Case lType 
       Case REG_SZ 
           sValue = vValue & Chr$(0) 
           SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue)) 
       Case REG_DWORD 
           nValue = vValue 
           SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, nValue, 4) 
   End Select 
End Function 

Public Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long) 
   Dim hKey As Long 
   Call RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, r) 
   Call RegCloseKey(hKey) 
End Sub 

Public Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long) 
   Dim hKey As Long 
   Call RegOpenKeyEx(HKEY_CLASSES_ROOT, sKeyName, 0, KEY_ALL_ACCESS, hKey) 
   Call SetValueEx(hKey, sValueName, lValueType, vValueSetting) 
   Call RegCloseKey(hKey) 
End Sub