Tools Links Login

Associate an Extension with an App

The following is reprinted for archival purposes from Gary Beene's Information Center, with permission from Mr. Beene himself.


Option Explicit

Private Const HKEY_CLASSES_ROOT = &H80000000

Private Declare Function RegCreateKey Lib _
   "advapi32.dll" Alias "RegCreateKeyA" _
  ( ByVal hKey As Long , ByVal lpSubKey As _
   String , phkResult As Long ) As Long

Private Declare Function RegCloseKey Lib _
   "advapi32.dll" ( ByVal hKey As Long ) As Long

Private Declare Function RegSetValueEx Lib _
   "advapi32.dll" Alias "RegSetValueExA" _
  ( ByVal hKey As Long , ByVal _
  lpValueName As String , ByVal _
  Reserved As Long , ByVal dwType _
   As Long , lpData As Any, ByVal _
  cbData As Long ) As Long

Private Const REG_SZ = 1



Public Function CreateFileAssociation(AppName As String , _
ByVal AppExtension As String , AppCommand As String ) As Boolean

    'Parameters:
    'AppName = name of application
    'AppExtension: = file extension

    'AppCommand = command line for application
    'Example:
    'CreateFileAssociation "Notepad", ".txt", "notepad.exe"

  Dim bAns As Boolean
  Dim sKeyName As String
  Dim sExtName As String
AppExtension = Trim(AppExtension)
  If Left(AppExtension, 1) <> "." Then Exit Function
sExtName = Mid (AppExtension, 2) & " File"

bAns = WriteStringToRegistry(HKEY_CLASSES_ROOT, _
   AppExtension, "" , sExtName)
  
  If bAns Then bAns = WriteStringToRegistry(HKEY_CLASSES_ROOT, _
     sExtName & "\shell\open\command" , "" , AppCommand)
    
CreateFileAssociation = bAns
End Function

Private Function WriteStringToRegistry(hKey As _
  Long , strPath As String , strValue As String , _
strdata As String ) As Boolean


Dim bAns As Boolean

On Error Goto ErrorHandler
   Dim keyhand As Long
   Dim r As Long
  r = RegCreateKey(hKey, strPath, keyhand)
   If r = 0 Then
       r = RegSetValueEx(keyhand, strValue, 0, _
          REG_SZ, ByVal strdata, Len(strdata))
       r = RegCloseKey(keyhand)
    End If
  
  WriteStringToRegistry = (r = 0)

Exit Function

ErrorHandler:
   WriteStringToRegistry = False
    Exit Function
  
End Function

About this post

Posted: 2021-02-11
By: ArchiveBot
Viewed: 123 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Comments

No comments have been added for this post.

You must be logged in to make a comment.