How to get font file name

I found some code which is working but only with TTF and with os language dependency. Is there some other method?

Like: I know Arial Bold and I want to get ARIALBD.TTF
Which works with *.fon files too!

It will go through all files and searching for the given font name!

Code:

---

Private Declare Function CreateScalableFontResource Lib "gdi32" Alias "CreateScalableFontResourceA" (ByVal fHidden As Long, ByVal lpszResourceFile As String, ByVal lpszFontFile As String, ByVal lpszCurrentPath As String) As Long
Private Function GetFontName(FileNameTTF As String)
  Dim hFile As Integer
  Dim Buffer As String
  Dim FontName As String
  Dim TempName As String
  Dim iPos As Integer

  TempName = App.Path & "\TEMP.FOT"
If CreateScalableFontResource(1, TempName, FileNameTTF, vbNullString) Then

  hFile = FreeFile

  Open TempName For Binary Access Read As hFile
  Buffer = Space(LOF(hFile))
  Get hFile, , Buffer
  iPos = InStr(Buffer, "FONTRES:") + 8
  FontName = Mid(Buffer, iPos, InStr(iPos, Buffer, vbNullChar) - iPos)
  Close hFile
  Kill TempName
End If

text = text + """" + Mid(FileNameTTF, InStrRev(FileNameTTF, "\") + 1) + """" + " " + FontName + vbCrLf
End Function

---