Instalar Fuente (tipo letra) desde botón vba Access

He modificado el ejemplo para tomar el archivo fuente desde la carpeta que elija:

Si hago clic en botón carpeta obtengo:

Selecciono la primera fuente (ebrima).

Hago clic en el botón Validar:

Me dice que la fuente está instalada, hago clic en Aceptar.

Ahora voy a seleccionar la otra fuente (ebrimabd). Hago clic en Validar.

Como la fuente no está instalada pregunta si la instalo:

En estas condiciones el código cambia.
Adicione en un módulo este código;

Option Compare Database
Option Explicit
Declare PtrSafe Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Declare PtrSafe Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
Public Function selectArchivo() As String
    'Creamos un control de errores
    On Error GoTo sol_err
    'Declaramos las variables
    Dim vFD As Object 'vFD=FileDialog
    Dim vRutaIni As String
    'Difinimos la ruta inicial
    vRutaIni = Application.CurrentProject.Path
    'Creamos el objeto FileDialog
    Set vFD = Application.FileDialog(msoFileDialogFilePicker)
    'Configuramos las características de nuestra ventana de dialogo
    With vFD
        .Title = "Seleccione el archivo de la copia de seguridad"
        .ButtonName = "A seleccionado el Archivo"
        .InitialView = msoFileDialogViewSmallIcons
        .InitialFileName = vRutaIni
        .Filters.Add "Archivos ttf", "*.ttf"
        'Detectamos el boton pulsado por el usuario
        If .Show = -1 Then
            'Asignamos a la función la carpeta seleccionada, convirtiendola a un valor de tipo String
            selectArchivo = CStr(.SelectedItems.Item(1))
        Else
            'Si se pulsa cancelar avisamos y salimos
            MsgBox "Ha cancelado la selección", vbOKCancel Or vbExclamation Or vbMsgBoxSetForeground, "Access"
            Exit Function
        End If
    End With
Salida:
    Exit Function
sol_err:
    MsgBox "Se ha producido un error: " & Err.Number & " - " & Err.Description
    Resume Salida
End Function
Public Function FuenteInstalada(sFuente As String) As Boolean
' Función para determinar si una fuente está instalada
' Ejemplo de llamada:
'                    FuenteInstalada("Arial")
   'Esta referencia ya debería estar configurada por defecto
   ' Herramientas > Referencias >OLE Automation
    Dim NewFont As StdFont
    On Error Resume Next
    Set NewFont = New StdFont
    With NewFont
        'Asignar el nombre de fuente propuesto
        ' No se asignará si la fuente no existe
        .Name = sFuente
        'Devuelve verdadero si la asignación de fuente tuvo éxito
        FuenteInstalada = (StrComp(sFuente, .Name, vbTextCompare) = 0)
        ' devuelve el nombre de fuente real a través de los argumentos
        sFuente = .Name
    End With
End Function

En el botón carpeta para buscar el archivo, ingrese este código en el evento Al hacer clic:

Private Sub btnArchivo_Click()
   Me.ctlFuente = selectArchivo()
End Sub

Ingrese este código en evento Al hacer clic del botón Validar.

Private Sub btnValidar_Click()
 On Error GoTo hay_error
  Dim result As Long
  Dim validafuente As Boolean
  Dim strSoloArchivo As String
  Dim fso As New Scripting.FileSystemObject
  If IsNull(Me.ctlFuente) Or Me.ctlFuente = "" Then
    MsgBox "No indicado la ruta y nombre de la fuente", vbInformation, "Cuidado.."
    Exit Sub
  End If
   strSoloArchivo = fso.GetBaseName(Me.ctlFuente) 'Obtengo solo el nombre del archivo sin extensión
   validafuente = FuenteInstalada(strSoloArchivo)
  If validafuente Then
    MsgBox "La fuente está instalada", vbInformation, "Le informo"
    Exit Sub
  Else
    If MsgBox("¿Instala la fuente?", vbQuestion + vbYesNo + vbDefaultButton2, "Instala fuente") = vbNo Then
      Exit Sub
    Else
     result = AddFontResource(Me.ctlFuente & ".ttf")
        If Err.Number = 0 Then
          MsgBox "Fuente instalada satisfactoriamente", vbInformation, "Le cuento"
        End If
    End If
  End If
hay_error_exit:
  Exit Sub
hay_error:
    MsgBox "Ocurrión el error " & Err.Description & vbCrLf & Err.Description, vbCritical, "Error..."
    Resume hay_error_exit
End Sub

Observe que es diferente a lo expuesto anteriormente, ahora requiere del botón para buscar archivos ttf y FileSystemObject para obtener del método GetBaseName el nombre del archivo sin extensión, porque así lo requiere la función FuenteInstalada().

No olvide en referencias, hacer referencia a Microsoft Scripting Runtime.

Se puede utilizar la función DIR para indagar si ya esta en el directorio FONTs.

Creo que es mas sencillo intentar instalarla y que sea el sistema el que la rechace al no permitir duplicidades.

Tampoco se debería perder de vista que en muchas ocasiones los usuarios carecen de permisos para instalar recursos en sus maquinas en directorios que no sean propios.

La pregunta curiosa es:
¿Esa instalación no debería hacerse en el momento de instalar la aplicación?, los programas que hay para ello acostumbran a permitir instalaciones condicionadas.