Tipp 0458 Formularfelder - Datenbank erstellen (DAO)
Autor/Einsender:
Datum:
  Angie
24.08.2005
Entwicklungsumgebung:   Word 2000
In diesem Beispiel wird aus den angegebenen Dokumenten aus dem Inhalt von Text-Formularfeldern mittels DAO (Data Access Objects) eine neue Access-Datenbank erstellt.
Ein Beispiel aus der Praxis: Es wurden bereits zig Word-Dokumente (z. B. Briefe) erstellt, in denen in Text-Formularfeldern Adressen eingegeben wurde. Nun soll aus diesen bereits bestehenden Dokumenten eine Adressdatenbank erstellt werden. Manuell kann dies, je nach Anzahl der Dokumente, in mühevolle "Handarbeit" ausarten.
Sollen mehrere Dokumente in einer Schleife bearbeitet werden, dann handelt es sich meistens um eine einmalige Aktion. Aber auch bei einer einmaligen Aktion wäre es sehr störend, wenn bei jedem eventuell aufgetretenen "Fehler" eine Mitteilung (MsgBox) oder Dialog angezeigt werden würde, sinnvoll ist es jedoch, den Ablauf zu protokollieren. In diesem Fall bietet es sich an, für die Protokollierung zusätzliche Felder in der Tabelle in der Datenbank aufzunehmen, hier je ein Feld für Meldung, Pfad und Name der Datei.
Prozedur zum Erstellen der Access-Datenbank
Der Prozedur für die Erstellung der Access-Datenbank wird
  -  der Dateiname der zu erstellenden Access-Datenbank (inkl. Pfad)
  -  der Name der zu erstellenden Tabelle
  -  ein Datenfeld mit den Dateinamen der Word-Dokumente (inkl. Pfad)
  -  ein Datenfeld mit den Namen der Text-Formularfelder, die ausgelesen werden sollen
  -  und optional das Lesekennwort für Dokumente, die ggf. kennwortgeschützt sind,
übergeben.
Die Dokumente werden in einer neu erstellten Word-Instanz nacheinander schreibgeschützt geöffnet. In der Statusleiste der sichtbaren aktiven Word-Instanz wird der aktuelle Status der Bearbeitung angezeigt.
Um eine reibungslose Ausführung der Prozedur für das Auslesen der Dokumente zu ermöglichen, also ohne "störende" Dialoge oder Fehlermeldungen usw., wurden die folgenden Punkte berücksichtigt:
Auto-Makros
Dokumente und/oder Dokumentvorlagen können sogenannte Auto-Makros, Ereignisse des Application-Objekts und/oder Ereignisse des Document-Objekts beinhalten, die beispielsweise beim Öffnen und/oder Schließen der Dokumente automatisch ausgeführt werden. Mit der WordBasic-Funktion DisableAutoMacros wird die Ausführung von Auto-Makros verhindert.
Lesekennwort
Um zu verhindern, dass bei Dokumenten, die mit einem Lesekennwort versehen sind, der Word-Dialog für die Kennworteingabe angezeigt wird, kann hier entweder ein gültiges Lesekennwort angegeben werden, oder aber auch ein "Dummy"-Kennwort. Wird ein gültiges Kennwort angegeben, wird das Dokument zur Bearbeitung geöffnet, andernfalls nicht. Wenn das Dokument nicht zum Lesen geöffnet werden kann, wird ein Datensatz mit Fehlermeldung, Pfad und Dateiname erstellt.
Text-Formularfelder
Wenn das Dokument geöffnet werden kann, wird in der entsprechenden Spalte in der Datenbank protokolliert, ob alle zu ermittelnden Text-Formularfelder im Dokument vorhanden sind, oder nur manche oder keine vorhanden sind.
 
Private Const mc_MsgTitle As String = "VB-fun-Demo - " & _
      "Text-Formularfelder aus Dokumente in Datenbank einlesen"

Function CreateMDBFromFormFields(ByVal strDBFileName As String, _
      ByVal strDBTableName, ByRef astrWDFiles() As String, _
      ByRef astrFFields() As String, Optional strDocPWD As _
      Variant) As Boolean

  Const cDBFldNote  As String = "ImportNote"
  Const cDBFldPath  As String = "ImportFilePath"
  Const cDBFldFile  As String = "ImportFileName"

  Dim objWDApp      As Word.Application
  Dim objWDDoc      As Word.Document

  Dim nFilesCnt     As Long
  Dim nFile         As Long

  Dim strFileName   As String
  Dim strPath       As String
  Dim strFile       As String

  Dim nFFieldsCnt   As Long
  Dim objFField     As FormField
  Dim strFldName    As Variant

  Dim nField        As Long
  Dim nCounter      As Long

  Dim blnKillDB     As Boolean

  nFFieldsCnt = UBound(astrFFields)

  ThisDocument.Application.StatusBar = "Bitte warten...   " & _
      "Die Datenbank wird erstellt."
  DoEvents

  On Error Resume Next
  Kill strDBFileName

  On Error GoTo err_Handler

  Dim dbsNew As DAO.Database
  Dim tbdNew As DAO.TableDef
  Dim rstNew As DAO.Recordset
  
  Set dbsNew = DBEngine.Workspaces(0).CreateDatabase( _
        strDBFileName, dbLangGeneral, dbEncrypt)

  Set tbdNew = dbsNew.CreateTableDef(strDBTableName)
  With tbdNew
    .Fields.Append .CreateField("ID", dbLong)
    .Fields(0).Attributes = dbAutoIncrField

    For nField = 0 To nFFieldsCnt
      .Fields.Append .CreateField(astrFFields(nField), dbText, 255)
      .Fields(.Fields.Count - 1).AllowZeroLength = True
    Next

    .Fields.Append .CreateField(cDBFldNote, dbText, 255)
    .Fields.Append .CreateField(cDBFldPath, dbText, 255)
    .Fields.Append .CreateField(cDBFldFile, dbText, 255)
  End With
  dbsNew.TableDefs.Append tbdNew

  Set rstNew = dbsNew.OpenRecordset(strDBTableName)

  On Error Resume Next
  Set objWDApp = CreateObject("Word.Application")
  If Err.Number = 0 Then
    objWDApp.WordBasic.DisableAutoMacros 1

    If IsMissing(strDocPWD) Or Len(strDocPWD) = 0 Then
        strDocPWD = "PWD"
    End If

    nFilesCnt = UBound(astrWDFiles)

    For nFile = 0 To nFilesCnt
      ThisDocument.Application.StatusBar = "Bitte warten...  " & _
          "Dokument " & CStr(nFile + 1) & " von " & _
          CStr(nFilesCnt + 1) & " wird bearbeitet!"
      DoEvents

      strFileName = astrWDFiles(nFile)
      strFile = Dir$(strFileName)
      strPath = Left$(strFileName, Len(strFileName) - Len(strFile))

      Err.Clear
      Set objWDDoc = objWDApp.Documents.Open( _
            FileName:=strFileName, ConfirmConversions:=False, _
            ReadOnly:=True, AddToRecentFiles:=False, _
            PasswordDocument:=strDocPWD)

      If Err.Number = 0 Then
        With rstNew
          .AddNew

          Err.Clear
          For nField = 0 To nFFieldsCnt
            strFldName = astrFFields(nField)
            .Fields(strFldName).Value = _
                  objWDDoc.FormFields(strFldName).Result
          Next
          If Err.Number = 0 Then
            .Fields(cDBFldNote).Value = _
                  "Alle Text-Formularfelder in Dok vorhanden."
          Else
            .Fields(cDBFldNote).Value = "Nicht alle oder " & _
                  "keine der Formularfelder in Dok vorhanden."
          End If
          .Fields(cDBFldPath).Value = strPath
          .Fields(cDBFldFile).Value = strFile

          .Update
        End With
        objWDDoc.Close False
        Set objWDDoc = Nothing

      Else
        With rstNew
          .AddNew
          .Fields(cDBFldNote).Value = _
                "Fehler: Dokument konnte nicht geöffnet werden."
          .Fields(cDBFldPath).Value = strPath
          .Fields(cDBFldFile).Value = strFile
          .Update
        End With
      End If
    Next

    objWDApp.WordBasic.DisableAutoMacros 0
    objWDApp.Quit
    Set objWDApp = Nothing

    CreateMDBFromFormFields = True

  Else
    blnKillDB = True
    MsgBox "Es konnte keine neue Word-Instanz erstellt werden!", _
         vbOKOnly + vbCritical, mc_MsgTitle
  End If

exit_Func:
  On Error Resume Next

  rstNew.Close
  dbsNew.Close

  Set tbdNew = Nothing
  Set rstNew = Nothing
  Set dbsNew = Nothing

  If blnKillDB Then Kill strDBFileName

  On Error GoTo 0
  Exit Function

err_Handler:
  MsgBox "Fehler: " & Err.Number & vbCrLf & Err.Description, _
        vbOKOnly + vbCritical, mc_MsgTitle
  blnKillDB = True
  Resume exit_Func
End Function
 
Beispiel-Aufruf
In folgendem Beispiel wurde für die Ermittlung der Word-Dokumente im vorgegebenen Verzeichnis die Funktion GetWDFiles() aus unserem Tipp Dateien in vorgegebenen Verzeichnis ermitteln verwendet. Der Code der Funktion ist hier nicht abgebildet, jedoch im Download-Beispiel enthalten.
Das Datenfeld mit den Namen der auszulesenden Text-Formularfelder wird hier "zu Fuß" erstellt. Es wäre durchaus möglich, ein dynamisches Datenfeld auch per VBA aus dem ersten Dokument zu erstellen, dies ist jedoch nur dann sinnvoll, wenn nicht unzählige Formularfelder enthalten sind, die gar nicht ausgelesen werden sollen.
 
Public Sub Start_CreateDatabase()
  Dim strDBFileName   As String
  Dim strDBTableName  As String

  Dim strPathDocs     As String
  Dim strDocPWD       As String
  Dim astrWDFiles()   As String
  Dim astrFFields(0 To 5) As String

  Dim blnStatusBar    As Boolean

  strDBFileName = ThisDocument.Path & "\" & "Adressen.mdb"
  strDBTableName = "tbl_Adressen"

  strPathDocs = ThisDocument.Path & "\TestDateien\"
  strDocPWD = "test"

  astrFFields(0) = "Anrede"
  astrFFields(1) = "Vorname"
  astrFFields(2) = "Nachname"
  astrFFields(3) = "Strasse"
  astrFFields(4) = "Plz"
  astrFFields(5) = "Ort"

  If Len(Dir$(strPathDocs, vbDirectory)) > 0 Then
    If GetWDFiles(astrWDFiles(), strPathDocs, False) Then
      With ThisDocument.Application
        blnStatusBar = .DisplayStatusBar
        .DisplayStatusBar = True
      End With

      If CreateMDBFromFormFields(strDBFileName, strDBTableName, _
             astrWDFiles(), astrFFields(), strDocPWD) = True Then

        MsgBox "Die Datenbank wurde erfolgreich erstellt!", _
              vbOKOnly + vbInformation, mc_MsgTitle
      End If

      With ThisDocument.Application
        .StatusBar = ""
        .DisplayStatusBar = blnStatusBar
      End With

      Erase astrWDFiles

    Else
      MsgBox "Keine Word-Dokumente im Verzeichnis " & vbCrLf & _
             strPathDocs & " gefunden!", vbInformation, _
             mc_MsgTitle
    End If
  Else
    MsgBox "Das Verzeichnis " & vbCrLf & strPathDocs & vbCrLf & _
          "existiert nicht!", vbInformation, mc_MsgTitle
  End If
End Sub
 
Hinweis
Um diesen Tipp ausführen zu können, muss die Microsoft DAO 3.x Object Library in das Projekt eingebunden werden.
Access-Datenbank-Format
Es gibt die verschiedensten Methoden, eine versionsunabhängige Access-Datenbank zu erstellen. In diesem Beispiel ist die Version von der im Projekt eingebundenen DAO-Bibliothek abhängig. Um eine Access-Datenbank erstellen zu können, die in Access 97 lesbar und editierbar ist, muss die Microsoft DAO 3.51 Object Library in das Projekt eingebunden werden, für eine Access-Datenbank, die ab Access 2000 lesbar und ohne Konvertierung editierbar sein soll, die Microsoft DAO 3.6 Object Library.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
Word-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (40,5 kB) Downloads bisher: [ 823 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 31. August 2011