Il y a les fonctions internes de VBA (telles que Abs ou Instr ) mais il peut y avoir aussi les fonctions définies par l'utilisateur. Elles renvoient dans leur nom un résultat qui sera utilisé dans l'application.
On crée les fonctions dans le module de feuille ou de code. On peut les définir publique ou privée par Public ou Private.

Voici 3 fonctions qui pourront vous être utiles pour le développement en VBA.
Très différentes l'une de l'autre, toutes les trois concernent la recherche de fichiers ou de répertoire.
Chacune est suivie d'un exemple d'utilisation.

Au menu :

• FindFile : L'équivalent de la commande AutoLISP de même nom.
• FouilleTout : Recherche d'un fichier sur tous les disques accessibles à l'aide de fonctions API.
• ChercheChemin : Recherche d'un répertoire sur tous les disques accessibles à l'aide de fonctions API.

Public Function FindFile(FileName As String) As String
  Dim Path As String                                      ' le chemin à trouver
  Dim SupportPath As String                               ' copie des chemins Support d'Acad
  Dim Pos As Integer                                      ' position du séparateur dans SupportPath
  '----On présume que c'est un chemin complet si le nom fourni contient '\' ------------------------
  If InStr(1, FileName, "\") > 0 Then                     ' recherche d'un antislash
    FindFile = FileName                                   ' alors copie le chemin+nom comme résultat
    On Error Resume Next                                  ' en cas d'erreur disque
    If Dir$(FileName) = "" Then FindFile = ""             ' s'il n'existe pas, change le resultat en ""
    If Err Then FindFile = ""                             ' si erreur, résultat ""
    Exit Function                                         ' retourne le résultat à la routine appelante
  End If
  '---- Recherche dans le répertoire courant ----------------------------------------------------------------
  FindFile = CurDir$ & "\" & FileName                     ' construction chemin+fichier à tester
  If Dir$(FindFile) <> "" Then Exit Function              ' s'il existe, retourne comme resultat
  '----Recherche dans le répertoire du dessin ---------------------------------------------------------------
  Path = ThisDrawing.FullName                             ' Nom complet du dessin en cours
  If Path <> "" Then                                      ' Pour être sûr que ce n'est pas un dessin sans nom
    Path = Left$(Path, Len(Path) - Len(ThisDrawing.Name)) ' on retire le nom à la fin du chemin
    FindFile = Path & FileName                            ' construction chemin + nom du fichier
    If Dir$(FindFile) <> "" Then Exit Function            ' s'il existe, retourne comme resultat
  End If
  '----Recherche dans les répertoires de fichiers de Support ------------------------------------------------
  SupportPath = ThisDrawing.Application.Preferences.SupportPath           ' copie des chemins support
  If Right$(SupportPath, 1) <> "\" Then SupportPath = SupportPath & "\"   ' vérifie si '\' à la fin
  Do While Len(SupportPath) > 0                           ' teste chaque répertoire de Support
    Pos = InStr(1, SupportPath, ";")                      ' cherche les séparateurs de répertoires
    If Pos > 0 Then                                       ' si un caractère séparateur trouvé...
      Path = Left$(SupportPath, Pos - 1)                  '...extrait le chemin devant ce séparateur
    Else                                                  ' sinon, plus de séparateur...
      Path = SupportPath                                  '...c'est le dernier chemin de SupportPath
    End If
    If Right$(Path, 1) <> "\" Then Path = Path & "\"      ' vérifie si '\' à la fin
    FindFile = Path & FileName                            ' construction chemin + nom du fichier à tester
    If Dir$(FindFile) <> "" Then Exit Function            ' s'il existe, retourne comme résultat
    SupportPath = Right$(SupportPath, Len(SupportPath) - Len(Path)) ' supprime le chemin venant d'être testé
    If Left$(SupportPath, 1) = ";" Then                             ' s'il y a un séparateur,
      SupportPath = Right$(SupportPath, Len(SupportPath) - 1)       ' le supprimer également
    End If
  Loop                                                    ' teste le chemin suivant dans SupportPath
  '----Recherche dans le répertoire Programme d'AutoCAD -----------------------------------------------------
  Path = ThisDrawing.Application.Path                     ' chemin de ACAD.EXE
  If Right$(Path, 1) <> "\" Then Path = Path & "\"        ' vérifie si '\' à la fin
  FindFile = Path & FileName                              ' construction chemin + nom du fichier à tester
  If Dir$(FindFile) <> "" Then Exit Function              ' s'il existe, retourne comme résultat
  '----Fichier non trouvé, une chaîne vide est retournée ----------------------------------------------------
  FindFile = ""
End Function

Public Sub TestFindFile()
  Dim res As String                                       ' Le résultat de la fonction
  Dim msg As String                                       ' messages à l'utilisateur
  '----Demande à l'utilisateur le nom du fichier----------------------------------------------------------------
  msg = "Entrez le nom du fichier que vous désirez tester avec la fonction FindFile." & vbCrLf & vbCrLf
  msg = msg & "FindFile va regarder dans le répertoire courant," & vbCrLf
  msg = msg & "le répertoire contenant le dessin en cours (s'il y en a un)," & vbCrLf
  msg = msg & "les répertoires des fichiers de Support d'AutoCAD, " & vbCrLf
  msg = msg & "et le répertoire des fichiers Programmes d'AutoCAD." & vbCrLf
  res = InputBox(msg, "Test de FindFile", "acad14.cfg")
  '----Retrouver le chemin complet avec FindFile----------------------------------------------------------------
  If res <> "" Then                                       ' si l'utilisateur clique sur 'Annuler', res = ""
    res = FindFile(res)                                   ' recherche le fichier
    If res = "" Then                                      ' FindFile retourne "" si fichier non trouvé
      msg = "Ce fichier ne peut être trouvé."             ' compose le message
      MsgBox msg, vbInformation, "Test de FindFile"       ' et prévient l'utilisateur
    Else
      msg = "Fichier trouvé dans : '" & res & "'."        ' FindFile retourne le chemin complet + nom du fichier
      MsgBox msg, vbInformation, "Test de FindFile"       ' Donne le résultat à l'utilisateur
    End If
  End If
End Sub

La macro comprend les éléments suivant :

• La fonction ListeDisques() : Une petite fonction qui vous donne la liste des disques logiques.
• La fonction FouilleDisque(Disque, Fichier) : Fonction principale de recherche d'un fichier sur un disque.
• La fonction FouilleTout(Fichier) : Fonction qui lance FouilleDisque sur chacun des disques donnés par la fonction ListeDisques.



• La macro TestFouilleTout(): Le programme avec la petite feuille pour tester les fonctions ci-dessus.

• Les déclarations des 3 fonctions API nécessaires.
• La déclaration de type personnalisé BrowseInfo qui sert à la fonction API qui affichera le navigateur.
• La fonction ChercheChemin elle-même.

' Déclarations des fonctions API
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal ByVallpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Function ChercheChemin() As String
'demande un chemin à l'utilisateur

    Dim lpIDList As Long
    Dim sBuffer As String
    Dim strTitre As String
    Dim tBrowseInfo As BrowseInfo
    Dim retval
    MAX_PATH = 255

    On Error GoTo Erreur

    ' Titre de la boîte
    strTitre = "Sélectionnez le répertoire" & Chr$(13) & _
		"Les sous-répertoires sont également acceptés."

    With tBrowseInfo
      .lpszTitle = lstrcat(strTitre, "")
      .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With

    ' affiche le navigateur
    lpIDList = SHBrowseForFolder(tBrowseInfo)

    ' teste la valeur de retour
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        ' transforme la valeur de retour qui est un Long
        retval = SHGetPathFromIDList(lpIDList, sBuffer)
        ' retire le caractère nul et ce qui vient après
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        ChercheChemin$ = sBuffer

        ' ajoute l'anti-slash (\) si nécessaire
        If Not Right$(ChercheChemin$, 1) = "\" Then
            ChercheChemin$ = ChercheChemin$ & "\"
        End If
     Else
        ChercheChemin$ = ""
    End If

    Exit Function

Erreur:
    ChercheChemin$ = ""
End Function