Tipp 2.9 - Formulare in String

Wie kann ich einem String die Namen aller Formulare der aktuellen Datenbank übergeben?

Mit dieser Funktion können Sie einem String die Namen aller Formulare der aktuellen Datenbank übergeben. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Beispiel:

Option Explicit
 
Public Function A2XFrmsToString( _
                                 psIn As String, _
                                 psDelimit As String) _
                                 As Integer
  '// =====================================================
  '// Methode   | Übergibt einem String die Namen aller
  '//           | Formulare in der aktuellen DB
  '// -----------------------------------------------------
  '// Parameter | psIn      - Leerstring
  '//           | psDelimit - Trennzeichen
  '// -----------------------------------------------------
  '// Rückgabe  | Integer - Anzahl Formulare
  '// -----------------------------------------------------
  '// Erstellt  | Manuela Kulpa
  '//           | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispielaufruf:
  '// Dim iCount As Integer
  '// Dim sForms As String
  '// iCount = A2XFrmsToString(sForms, ", ")
  '// Debug.Print "Formulare: " & sForms
  '// =====================================================
  On Error GoTo HandleErr
  ' Verweis auf DAO 3.6 Object Library muss gesetzt sein!
  Dim dbs      As DAO.Database
  Dim con      As DAO.Container
  Dim doc      As DAO.Document
 
  Dim iCounter As Integer
  Dim iCount   As Integer
  Dim sName    As String
 
  Set dbs = CurrentDb()
  Set con = dbs.Containers("Forms")
 
  iCount = con.Documents.Count
  iCounter = 0
 
  For Each doc In con.Documents
    sName = doc.Name
    psIn = psIn & sName
    If iCounter < iCount - 1 Then
      psIn = psIn & psDelimit
    End If
    iCounter = iCounter + 1
  Next doc
 
  A2XFrmsToString = iCount
 
HandleExit:
  If Not dbs Is Nothing Then Set dbs = Nothing
  Exit Function
 
HandleErr:
  Select Case Err.Number
    Case Else
      MsgBox "Fehler " & Err.Number & ": " & _
             Err.Description, vbCritical, _
             "basFrm.A2XFrmsToString"
  End Select
  Resume HandleExit
End Function