How do I get a file's association?

How do I get a file's association?

E.G.
blahblah.txt ---> Text file
blahblah.doc ---> Word document
blahblah.exe ---> Executable


-----------------
Niv
[email protected]

[dimava]

I think that it has something to do with the registrey, goto RUN and type regedit and just look around, you'll find it

This is how you retrieve the extension of a file only.

Public Function GetExtension(lpFileName As String)
'parses extension from filename and returns the extension
'no extension is sent back as """"

    Dim nPosition As Integer

    If InStr(1, lpFileName, ".") < 1 Then
     Exit Function
     Else
        nPosition = InStr(1, lpFileName, ".")
        GetExtension = Mid$(lpFileName, _
            nPosition, _
            Len(lpFileName) - (nPosition - 1))
    End If
End Function

You can use the Instr function to check and see what file it is.

x = GetExtension(commondialog1.filename)
If Instr(x, "txt") Then Msgbox Commondialog1.filename & "> " & Text File"

Or would you like to get all of the registered types?

Tip by Sam Huggill

Retrieve a list of all the registered file type found in HKEY_CLASSES_ROOT 

Add this code to a module:

Option Explicit
Public Const MAX_PATH = 260
' hKey values
Public Const HKEY_CLASSES_ROOT = &H80000000
' Return codes from Registration functions.
Public Const ERROR_SUCCESS = 0
Public Const vbAscDot = 46 ' Asc(".") = 46
Type FILETIME ' ft
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Declare Function RegEnumKeyEx Lib_ 
"advapi32.dll" Alias "RegEnumKeyExA" _
(ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, _
ByVal lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
lpftLastWriteTime As FILETIME) As Long

'LONG RegEnumKeyEx(
' HKEY hKey, // handle of key to enumerate
' DWORD dwIndex, // index of subkey to enumerate
' LPTSTR lpName, // address of buffer for subkey name
' LPDWORD lpcbName, // address for size of subkey buffer
' LPDWORD lpReserved, // reserved
' LPTSTR lpClass, // address of buffer for class string
' LPDWORD lpcbClass, // address for size of class buffer
' );

' 
Public Type SHFILEINFO ' shfi
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type

Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As SHGFI_flags) As Long

Enum SHGFI_flags
SHGFI_LARGEICON = &H0 ' sfi.hIcon is large icon
SHGFI_SMALLICON = &H1 ' sfi.hIcon is small icon
SHGFI_OPENICON = &H2 ' sfi.hIcon is open icon
SHGFI_SHELLICONSIZE = &H4 ' sfi.hIcon is shell size (not system size), rtns BOOL
SHGFI_PIDL = &H8 ' pszPath is pidl, rtns BOOL
SHGFI_USEFILEATTRIBUTES = &H10 ' pretent pszPath exists, rtns BOOL
SHGFI_ICON = &H100 ' fills sfi.hIcon, rtns BOOL, use DestroyIcon
SHGFI_DISPLAYNAME = &H200 ' isf.szDisplayName is filled, rtns BOOL
SHGFI_TYPENAME = &H400 ' isf.szTypeName is filled, rtns BOOL
SHGFI_ATTRIBUTES = &H800 ' rtns IShellFolder::GetAttributesOf SFGAO_* flags
SHGFI_ICONLOCATION = &H1000 ' fills sfi.szDisplayName with filename
' containing the icon, rtns BOOL
SHGFI_EXETYPE = &H2000 ' rtns two ASCII chars of exe type
SHGFI_SYSICONINDEX = &H4000 ' sfi.iIcon is sys il icon index, rtns hImagelist
SHGFI_LINKOVERLAY = &H8000 ' add shortcut overlay to sfi.hIcon
SHGFI_SELECTED = &H10000 ' sfi.hIcon is selected icon
End Enum

Public Function GetFileTypeName(sFile As String) As String

' If successful returns the specified file's typename,
' returns an empty string otherwise.
' sFile does not have to exist and can be just a file extension.

Dim sfi As SHFILEINFO
If SHGetFileInfo(sFile, 0, sfi, Len(sfi), _
SHGFI_TYPENAME Or SHGFI_USEFILEATTRIBUTES) Then
GetFileTypeName = GetStrFromBufferA(sfi.szTypeName)
End If

End Function

Public Function GetStrFromBufferA(sz As String) As String
ANSII string.

If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
' If sz had no null char, the Left$ function
' above would return a zero length string ("").
GetStrFromBufferA = sz
End If
End Function

Add this code to the form's General Declarations procedure:

Private Sub InsertFileTypeNames()
' Inserts the file extension icons to the listbox control
Dim i As Long
Dim sSubkey As String * MAX_PATH
Dim sClass As String * MAX_PATH
Dim ft As FILETIME
Dim sTypeName As String

i = -1
Do
' Walk thru each extension subkey. The sequence of keys
' enumed is completely random, (1st written to last written...?)
i = i + 1
If RegEnumKeyEx(HKEY_CLASSES_ROOT, i, sSubkey, MAX_PATH, _
0, sClass, MAX_PATH, ft) = ERROR_SUCCESS Then
If Asc(sSubkey) = vbAscDot Then
' Pass the entire string, GetFileTypeName uses everything before the 1st null char
sTypeName = GetFileTypeName(sSubkey)
If Len(sTypeName) Then
List1.AddItem GetStrFromBufferA(sSubkey) & vbTab & sTypeName
End If
End If
Else
Exit Do
End If
Loop
End Sub

Private Sub Command1_Click()
List1.Clear
MousePointer = 11
'fill the listbox box with the file types and their extensions
Call InsertFileTypeNames
MousePointer = 0
End Sub

[kedaman]

Using my registry module on my homepage:

regval("Root\" & Regval("Root\" & Extension & "\") & "\open\command\")

Kedaman, what exactly does your code do? I have not tried it yet. But before I do, I'd rather here your words of what it does.

[kedaman]

Regval returns or sets the value in registry, use it as a property

That example returns the command line to the open command to the associated extension.
Well if you want to have all the commands you can use the subkeys function which returns all the subkeys