getting the font folder on windows

[Pouncer]

i need to find the font folder programatically on windows and put all the fonts into a listbox on my program

but how can i find the font folder??

on my machine its C:\windows\fonts

but its different on other peoples

can someone help me

[gavio]

Try this:

Option Explicit
 
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 
Private Sub Command1_Click()
    Dim strSave As String, strPath As String
        strSave = String(200, Chr$(0))
        strPath = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave))) & "\Fonts"
            MsgBox strPath
End Sub

Fonts is always the same.

[Pouncer]

thanks

[bushmobile]

here's how to get it outright:

Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
    (ByVal hwnd As Long, ByVal pszPath As String, ByVal csidl As Long, ByVal fCreate As Long) As Long
 
Private Const CSIDL_FONTS = &H14&
 
Private Sub Form_Load()
    Debug.Print GetFolderPath(CSIDL_FONTS)
End Sub
 
Private Function GetFolderPath(ByVal lID As Long) As String
    Dim sPath As String
    sPath = Space$(260)
    SHGetSpecialFolderPath Me.hwnd, sPath, lID, False
    GetFolderPath = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End Function

[RhinoBull]

...Fonts is always the same.

Not necessary - there is a more precise way to determine any special folder path:

Option Explicit
 
Private Const CSIDL_FONTS = &H14
Private Const MAX_PATH = 260
Private Const NOERROR = 0
 
Private Type SHTEMID
    cb As Long
    abID As Byte
End Type
 
Private Type ITEMIDLIST
    mkid As SHTEMID
End Type
 
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, _
    ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long
 
Private Function GetSpecialfolder(CSIDL As Long) As String
Dim res As Long
Dim IDL As ITEMIDLIST
Dim sPath As String
 
    'Get the special folder
    res = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If res = NOERROR Then
        'Create a buffer
        sPath = Space$(512)
        'Get the path from the IDList
        res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
        'Remove the unnecessary chr$(0)'s
        GetSpecialfolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
        Exit Function
    End If
    GetSpecialfolder = ""
 
End Function
 
Private Sub Command1_Click()
    Debug.Print GetSpecialfolder(CSIDL_FONTS)
End Sub

[Hack]

i need to find the font folder programatically on windows and put all the fonts into a listbox on my program

If that is all you want to do, then you don't need to know where the Fonts folder is

Private Sub Form_Load()
    Dim i As Long
    For i = 0 To Screen.FontCount - 1
        List1.AddItem Screen.Fonts(i)
    Next     
End Sub

[RhinoBull]

... and to take it a bit further here a very nice sample:

Enumerate Windows Fonts with Font Preview

[Hack]

... and to take it a bit further here a very nice sample:

Enumerate Windows Fonts with Font Preview

Cool! I had not run into this tidbit before.

Randy is The Man!