Thanks to Ralf Gerstenberger for pointing out that WinXP seems to require the SHCNF_FLUSHNOWAIT flag in SHChangeNotify.

Subroutine AssociateFileExtension creates a root registry entry with a name describing the extension. Its value is the same name.

It then creates another entry named after the extension with value equal to the name used for the first entry.

Next the program adds a new value in the first entry called shell\open\command. It gives sets this value to the complete path to the program that should be associated with the extension.

Finally, the program adds another value to the first entry. This one is called DefaultIcon and specifies the default icon for files opened with the application.

Subroutine UnAssociateFileExtension deletes these keys for an application.

'Extension is three letters without the "."
'PathToExecute is full path to exe file
'Application Name is any name you want as description of
' Extension
Public Sub AssociateFileExtension(Extension As String, _
    PathToExecute As String, ApplicationName As String)
Dim sKeyName As String   'Holds Key Name in registry.
Dim sKeyValue As String  'Holds Key Value in registry.
Dim Ret&           'Holds error status, if any, from API
    ' calls.
Dim lphKey&        'Holds created key handle from
    ' RegCreateKey.

    Ret& = InStr(1, Extension, ".")
    If Ret& <> 0 Then
        MsgBox "Extension has . in it. Remove and try " & _
            "again."
        Exit Sub
    End If

    'This creates a Root entry called 'ApplicationName'.
    sKeyName = ApplicationName
    sKeyValue = ApplicationName
    Ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, _
        lphKey&)
    Ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

    'This creates a Root entry for the extension to be
    ' associated with 'ApplicationName'.
    sKeyName = "." & Extension
    sKeyValue = ApplicationName
    Ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, _
        lphKey&)
    Ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

    'This sets the command line for 'ApplicationName'.
    sKeyName = ApplicationName
    sKeyValue = PathToExecute & " %1"
    Ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, _
        lphKey&)
    Ret& = RegSetValue&(lphKey&, "shell\open\command", _
        REG_SZ, sKeyValue, MAX_PATH)

    'This sets the default icon
    sKeyName = ApplicationName
    sKeyValue = App.Path & "\" & App.EXEName & ".exe,0"
    Ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, _
        lphKey&)
    Ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, _
        sKeyValue, MAX_PATH)

    'Force Icon Refresh
    SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
'Thanks to Ralf Gerstenberger <ralf.gerstenberger@arcor.de>
' for pointing out
'that WinXP seems to require the SHCNF_FLUSHNOWAIT flag in
' SHChangeNotify
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/functions/shchangenotify.asp
End Sub

Public Sub UnAssociateFileExtension(Extension As String, _
    ApplicationName As String)
Dim sKeyName As String   'Finds Key Name in registry.
Dim sKeyValue As String  'Finds Key Value in registry.
Dim Ret&           'Holds error status, if any, from API
    ' calls.

    Ret& = InStr(1, Extension, ".")
    If Ret& <> 0 Then
        MsgBox "Extension has . in it. Remove and try " & _
            "again."
        Exit Sub
    End If

    'This deletes the default icon
    sKeyName = ApplicationName
    Ret& = RegDeleteKey(HKEY_CLASSES_ROOT, sKeyName & _
        "\DefaultIcon")

    'This deletes the command line for "ApplicationName".
    sKeyName = ApplicationName
    Ret& = RegDeleteKey(HKEY_CLASSES_ROOT, sKeyName & _
        "\shell\open\command")

    'This deletes a Root entry called "ApplicationName".
    sKeyName = ApplicationName
    Ret& = RegDeleteKey(HKEY_CLASSES_ROOT, sKeyName & _
        "\shell\open")

    'This deletes a Root entry called "ApplicationName".
    sKeyName = ApplicationName
    Ret& = RegDeleteKey(HKEY_CLASSES_ROOT, sKeyName & _
        "\shell")

    'This deletes a Root entry called "ApplicationName".
    sKeyName = ApplicationName
    Ret& = RegDeleteKey(HKEY_CLASSES_ROOT, sKeyName)

    'This deletes the Root entry for the extension to be
    ' associated with "ApplicationName".
    sKeyName = "." & Extension
    Ret& = RegDeleteKey(HKEY_CLASSES_ROOT, sKeyName)

    'Force Icon Refresh
    SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0
End Sub

Formatted by Neil Crosby