none
.Type = dbMemo .. und wie kann Format Rich-Text eingestellt werden?

    Frage

  • Ich bin vom answers.microsoft.com-Forummoderator mit meiner Anfrage hierher verwiesen worden..

    Hallo Allseits,

    bei einem Teil von einem Tab-Aufbau via VBA sieht es bei mir so aus:

    If rsB!FeldTyp = "dbMemo" Then
                      Set F = New Field
                      With F
                      .Name = rsB!Feldname
                      .Type = dbMemo
                       End With
                      T.Fields.Append F
    End If

    .Name und .Type = alles ok.

    Meine Anfrage/Problem:
    Wie kann hier ergänzt werden mit: .und-das-Memo-Feld-soll-Textformat: Rich-Text haben?

    Danke für Eure Hilfe.
    Gruß Steffen

     

    Mittwoch, 24. August 2011 08:00

Antworten

  • Hallo,

    Steffen Brose wrote:

    Habe ich das was übersehen?

    Weiss nicht. Hast du was nicht gepostet? z. B. was sich hinter

     Set F = New Field

    verbirgt?

    Bei mir sieht das so aus und funktioniert:

    Sub TestRTF()
     Dim Dbs As DAO.Database
     Dim Tdf As DAO.TableDef
     Dim Fld As DAO.Field
     Dim Prp As DAO.Property

     Set Dbs = CurrentDb
     Set Tdf = Dbs.TableDefs("tblA")
     Set Fld = Tdf.CreateField("Field1")  '<------------------

     With Fld
       .Type = dbMemo
     End With
     Tdf.Fields.Append Fld

     Set Prp = Fld.CreateProperty("TextFormat", dbByte, _
       CByte(acTextFormatHTMLRichText))
     Fld.Properties.Append Prp

     Set Prp = Nothing
     Set Fld = Nothing
     Set Tdf = Nothing
    End Sub


    Mitglied im http://www.dbdev.org
    FAQ: http://www.donkarl.com

    • Als Antwort markiert Steffen Brose Montag, 29. August 2011 09:14
    Mittwoch, 24. August 2011 14:38
    Moderator
  • Hallo Steffen,

    Die Objekte müssen unbedingt DAO Objekte sein:

    ·         Dim db As DAO.Database

    ·          Dim tdf As DAO.TableDef

    Dim T As DAO.TableDef

    Dim F As DAO.Field

    Dim prp As DAO.Property

    ·          Dim prp As DAO.PropertyGrüße,

    VG,

    Bogdan


    • Als Antwort markiert Steffen Brose Montag, 29. August 2011 09:14
    Mittwoch, 24. August 2011 13:10
    Moderator
  • Hallo Peter, hallo Bogdan,
    jetzt funktioniert alles easy.
    Aber bitte nicht über meinen LaienCode so laut....

    Weil ich ja in jeder Tabelle immer ein ID-Feld haben möchte, lasse ich nach der Tab-mit-ID-Erstellung jetzt gleich speichern.
    Weil jetzt die Tabellen da bzw. angelegt sind funktioniert auch RTF-Zuordnung bei Memo.
    Ich danke Euch - Bis zum nächsten Mal - Gruß Steffen

    P.S.: Peter, warum da 'Set F = New Field' stehen muss oder 'Set F = T.CreateField(Vaiable)' stehen kann = 0-Ahnung

    Der Code sieht jetz so aus:

    Public Function TabBauen2()
    Dim BE_TEST As DAO.Database
    Dim T As DAO.TableDef
    Dim F As DAO.Field
    Dim I As DAO.Index
    Dim IndexF As DAO.Field
    Dim prp As DAO.Property

    strSQL = "SELECT * FROM FE_Tab02_TabNeuEinbinden"
    Set rsA = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

    strSQL = "SELECT * FROM FE_Tab03_Felder"
    Set rsB = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

    Set BE_TEST = OpenDatabase(aktuellesBE) 'das aktuelle BE


    '----------------------------------------------als 1. Tabellen mit ID erzeugen und speichern
    Do Until rsA.EOF 'A = Tab mit neuen Tabellen
          
     Set T = BE_TEST.CreateTableDef(rsA![NameTab])
         
        Set F = New Field
        With F
        .Name = "ID"
        .Type = dbLong
        .Attributes = dbAutoIncrField
        End With
        T.Fields.Append F

        Set I = New Index ' Temporäres Indexfeld anlegen
        I.Name = "PrimaryKey"
        I.Primary = True ' Index als Primärschlüssel deklarieren
        Set IndexF = New Field ' Temporäres Indexfeld erstellen
        IndexF.Name = "ID"
        I.Fields.Append IndexF ' Indexfeld hinzufügen
        T.Indexes.Append I ' Index hinzufügen
           
        BE_TEST.TableDefs.Append T ' Tabelle hinzufügen
       
     rsA.MoveNext
    Loop

    rsA.MoveFirst
       
    '----------------------------------------------als 2. weitere Felder zufügen
       
    Do Until rsA.EOF 'A = Tab mit neuen Tabellen
    Set T = BE_TEST.TableDefs(rsA![NameTab])

                Do Until rsB.EOF
                
                   If rsA![NameTab] = rsB![TabName] Then
                     ' Felder erstellen und speichern
                       If rsB!FeldTyp = "dbDate" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbDate
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbText" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbText
                               .Size = rsB!FeldGroesse
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbLong" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbLong
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbMemo" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbMemo
                               End With
                               T.Fields.Append F
                                                                                 
                              
                             Set prp = F.CreateProperty("TextFormat", dbByte, CByte(acTextFormatHTMLRichText))
                              F.Properties.Append prp 'Fehlermeldung 3219: Unzulässige Operation
                              Set prp = Nothing
                      
                    End If
                  End If
                rsB.MoveNext
                Loop
        
        rsB.MoveFirst
       
    rsA.MoveNext
    Loop


    rsA.Close
    Set rsA = Nothing
    Set db = Nothing
    rsB.Close
    Set rsB = Nothing
    Set prp = Nothing
    Set BE_TEST = Nothing
    'Zum Schluss wieder Durchlauf
    TabellenEinbindenBeispielaufruf
    End Function

    Donnerstag, 25. August 2011 12:24

Alle Antworten

  • Hallo Steffen,
    Die Property TextFormat existiert nicht in der Field.Properties Collection, weil nicht Standard für alle Feldtypen ist. Muss man sie dazu mit Field.CreateProperty einfügen, wie hier beschrieben ist:
    Konkrett:
    Function CreateRichTextField()
     Dim db As DAO.Database
     Dim tdf As DAO.TableDef
     Dim fld As DAO.Field
     Dim prp As DAO.Property
    
     'Create the table with a memo field
     Set db = CurrentDb()
     Set tdf = db.TableDefs("Table1")
     Set fld = tdf.CreateField("MyRichTextField", dbMemo)
     tdf.Fields.Append fld
    
     'Set the property of the field
     Set prp = fld.CreateProperty("TextFormat", dbByte, _
      CByte(acTextFormatHTMLRichText))
     fld.Properties.Append prp
    
     'Clean up
     Set prp = Nothing
     Set fld = Nothing
     Set tdf = Nothing
     Set db = Nothing
    
    End Function
    

     [Source: http://www.accessmonster.com/Uwe/Forum.aspx/access/106534/Alter-Table-Column-to-RTF ]
    Grüße,
    Bogdan

    Mittwoch, 24. August 2011 08:46
    Moderator

  • Hallo Bogdan,

    weil 'keine' Ahnung, habe ich einfach mal CreateProperty angehangen.
    Bis zum Erzeugen des Memofeldes -  tdf.Fields.Append fld - ist ja eigentlich alles gleich. Bei Anfügen: fld.Properties.Append prp - kommt dann Fehler: Unzulässige Operation
    Hast Du einen Tipp? - Gruß Steffen

    If rsB!FeldTyp = "dbMemo" Then
       Set F = New Field
       With F
        .Name = rsB!Feldname
        .Type = dbMemo
       End With
       T.Fields.Append F
                                                                                 
                              
       Set prp = F.CreateProperty("TextFormat", dbByte, _
       CByte(acTextFormatHTMLRichText))
       F.Properties.Append prp '<--------Fehlermeldung 3219: Unzulässige Operation
       Set prp = Nothing
                      
    End If

    Mittwoch, 24. August 2011 09:35
  • Hallo Steffen,

    Die Objekte müssen unbedingt DAO Objekte sein:

    ·         Dim db As DAO.Database

    ·          Dim tdf As DAO.TableDef

    Dim T As DAO.TableDef

    Dim F As DAO.Field

    Dim prp As DAO.Property

    ·          Dim prp As DAO.PropertyGrüße,

    VG,

    Bogdan


    • Als Antwort markiert Steffen Brose Montag, 29. August 2011 09:14
    Mittwoch, 24. August 2011 13:10
    Moderator
  • Hallo Bogdan,

    also das ist jetzt meine ganze Funktion.
    Habe ich das was übersehen?

    Nur diese eine Zeile 'klemmt'.
    Wenn die ein rem hat laüft alles durch ... aber eben dann ohne Rich- Text

    Danke Dir - Gruß Steffen

     

    Public Function TabBauen()

    Dim db As DAO.Database, rs As DAO.Recordset
    Dim rsA As DAO.Recordset
    Dim rsB As DAO.Recordset

    Dim T As DAO.TableDef
    Dim F As DAO.Field
    Dim I As DAO.Index
    Dim IndexF As DAO.Field
    Dim prp As DAO.Property

    strSQL = "SELECT First(FE_Tab03_Felder.[TabName]) AS [TabNameFeld]" & _
    "FROM FE_Tab03_Felder " & _
    "GROUP BY FE_Tab03_Felder.[TabName]" 'guppiere nach Tab-Namen
    Set rsA = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

    strSQL = "SELECT * FROM FE_Tab03_Felder"
    Set rsB = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)


    Dim BE As DAO.Database 'das aktuelle BE
    Set db = DBEngine(0).OpenDatabase(aktuellesBE)

    'Aussenschleife Tabellen aus FE_TAB03_Felder
    Do Until rsA.EOF

            
    Set T = New TableDef
       
    T.Name = rsA![TabNameFeld] 'die Tab-Namen aus rsA
       
       
        'ID bei allen Tabellen gleich
        Set F = New Field
        With F
        .Name = "ID"
        .Type = dbLong
        .Attributes = dbAutoIncrField
        End With
        T.Fields.Append F

        Set I = New Index ' Temporäres Indexfeld anlegen
        I.Name = "PrimaryKey"
        I.Primary = True ' Index als Primärschlüssel deklarieren
        Set IndexF = New Field ' Temporäres Indexfeld erstellen
        IndexF.Name = "ID"
        I.Fields.Append IndexF ' Indexfeld hinzufügen
        T.Indexes.Append I ' Index hinzufügen

        'Innenschleife Felder
       
                Do Until rsB.EOF
                
                   If rsA![TabNameFeld] = rsB![TabName] Then
                     ' Felder erstellen und speichern
                       If rsB!FeldTyp = "dbDate" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbDate
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbText" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbText
                               .Size = rsB!FeldGroesse
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbLong" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbLong
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbMemo" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbMemo
                               End With
                               T.Fields.Append F
                                                                                 
                              
                              Set prp = F.CreateProperty("TextFormat", dbByte, _
                              CByte(acTextFormatHTMLRichText))
                              F.Properties.Append prp '                    <-- Fehlermeldung 3219: Unzulässige Operation
                              Set prp = Nothing
                      
                       End If
                  End If
                rsB.MoveNext
                Loop
       
       
          
        db.TableDefs.Append T ' Tabelle hinzufügen
        rsB.MoveFirst
       
    rsA.MoveNext
    Loop


    rsA.Close
    Set rsA = Nothing
    'Set db = Nothing
    rsB.Close
    Set rsB = Nothing

    'Zum Schluss wieder Durchlauf
    TabellenEinbindenBeispielaufruf
    End Function

    Mittwoch, 24. August 2011 13:34
  • Hallo,

    Steffen Brose wrote:

    Habe ich das was übersehen?

    Weiss nicht. Hast du was nicht gepostet? z. B. was sich hinter

     Set F = New Field

    verbirgt?

    Bei mir sieht das so aus und funktioniert:

    Sub TestRTF()
     Dim Dbs As DAO.Database
     Dim Tdf As DAO.TableDef
     Dim Fld As DAO.Field
     Dim Prp As DAO.Property

     Set Dbs = CurrentDb
     Set Tdf = Dbs.TableDefs("tblA")
     Set Fld = Tdf.CreateField("Field1")  '<------------------

     With Fld
       .Type = dbMemo
     End With
     Tdf.Fields.Append Fld

     Set Prp = Fld.CreateProperty("TextFormat", dbByte, _
       CByte(acTextFormatHTMLRichText))
     Fld.Properties.Append Prp

     Set Prp = Nothing
     Set Fld = Nothing
     Set Tdf = Nothing
    End Sub


    Mitglied im http://www.dbdev.org
    FAQ: http://www.donkarl.com

    • Als Antwort markiert Steffen Brose Montag, 29. August 2011 09:14
    Mittwoch, 24. August 2011 14:38
    Moderator
  • Hallo Peter,

    als Test habe ich nachfolgend gebaut und: funktioniert auch so.

    Public Function TestRTF()
    Dim Dbs As DAO.Database
    Dim Tdf As DAO.TableDef
    Dim Fld As DAO.Field
    Dim prp As DAO.Property

    MsgBox aktuellesBE
    Set Dbs = OpenDatabase("C:\Daten\MDB_11_mehrere_Projekte\Leeres TEST RTF.accdb")

    Set Tdf = Dbs.TableDefs("00_SysProjekt_Info")
    Set Fld = Tdf.CreateField("Feld22")

    With Fld
    .Type = dbMemo
    End With
    Tdf.Fields.Append Fld

    Set prp = Fld.CreateProperty("TextFormat", dbByte, CByte(acTextFormatHTMLRichText))
    Fld.Properties.Append prp

    Set prp = Nothing
    Set Fld = Nothing
    Set Tdf = Nothing

    Set Dbs = Nothing
    End Function

    Meine eigentliche Funktion funktioniert aber immer noch nicht.

    Muss eigentlich die Tab bei Ausführung von Fld.Properties.Append prp bereits vorhanden sein?

    Weil bei mir kommt ja db.TableDefs.Append T erst später.

    Danke Dir - Gruß Steffen

    Donnerstag, 25. August 2011 09:01
  • Hallo Peter,

    tja... es so...Ohne Tabelle = kein Fld.Properties.Append Prp...

    Also muss Dbs.TableDefs.Append Tdf davor stehen.

    So funktioniert es:

    Public Function TestRTF()
    Dim Dbs As DAO.Database
    Dim Tdf As DAO.TableDef
    Dim Fld As DAO.Field
    Dim prp As DAO.Property


    Set Dbs = OpenDatabase("C:\Daten\MDB_11_mehrere_Projekte\Leeres TEST RTF.accdb")

    Set Tdf = Dbs.CreateTableDef("00_SysProjekt_Info_66")
    Set Fld = Tdf.CreateField("Feld22")

    With Fld
    .Type = dbMemo
    End With
    Tdf.Fields.Append Fld
    Dbs.TableDefs.Append Tdf

    Set prp = Fld.CreateProperty("TextFormat", dbByte, CByte(acTextFormatHTMLRichText))
    Fld.Properties.Append prp

    Set prp = Nothing
    Set Fld = Nothing
    Set Tdf = Nothing

    Set Dbs = Nothing
    End Function

    Gruß Steffen

     

     

    Donnerstag, 25. August 2011 09:44
  • Hallo Peter, hallo Bogdan,
    jetzt funktioniert alles easy.
    Aber bitte nicht über meinen LaienCode so laut....

    Weil ich ja in jeder Tabelle immer ein ID-Feld haben möchte, lasse ich nach der Tab-mit-ID-Erstellung jetzt gleich speichern.
    Weil jetzt die Tabellen da bzw. angelegt sind funktioniert auch RTF-Zuordnung bei Memo.
    Ich danke Euch - Bis zum nächsten Mal - Gruß Steffen

    P.S.: Peter, warum da 'Set F = New Field' stehen muss oder 'Set F = T.CreateField(Vaiable)' stehen kann = 0-Ahnung

    Der Code sieht jetz so aus:

    Public Function TabBauen2()
    Dim BE_TEST As DAO.Database
    Dim T As DAO.TableDef
    Dim F As DAO.Field
    Dim I As DAO.Index
    Dim IndexF As DAO.Field
    Dim prp As DAO.Property

    strSQL = "SELECT * FROM FE_Tab02_TabNeuEinbinden"
    Set rsA = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

    strSQL = "SELECT * FROM FE_Tab03_Felder"
    Set rsB = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

    Set BE_TEST = OpenDatabase(aktuellesBE) 'das aktuelle BE


    '----------------------------------------------als 1. Tabellen mit ID erzeugen und speichern
    Do Until rsA.EOF 'A = Tab mit neuen Tabellen
          
     Set T = BE_TEST.CreateTableDef(rsA![NameTab])
         
        Set F = New Field
        With F
        .Name = "ID"
        .Type = dbLong
        .Attributes = dbAutoIncrField
        End With
        T.Fields.Append F

        Set I = New Index ' Temporäres Indexfeld anlegen
        I.Name = "PrimaryKey"
        I.Primary = True ' Index als Primärschlüssel deklarieren
        Set IndexF = New Field ' Temporäres Indexfeld erstellen
        IndexF.Name = "ID"
        I.Fields.Append IndexF ' Indexfeld hinzufügen
        T.Indexes.Append I ' Index hinzufügen
           
        BE_TEST.TableDefs.Append T ' Tabelle hinzufügen
       
     rsA.MoveNext
    Loop

    rsA.MoveFirst
       
    '----------------------------------------------als 2. weitere Felder zufügen
       
    Do Until rsA.EOF 'A = Tab mit neuen Tabellen
    Set T = BE_TEST.TableDefs(rsA![NameTab])

                Do Until rsB.EOF
                
                   If rsA![NameTab] = rsB![TabName] Then
                     ' Felder erstellen und speichern
                       If rsB!FeldTyp = "dbDate" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbDate
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbText" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbText
                               .Size = rsB!FeldGroesse
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbLong" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbLong
                               End With
                               T.Fields.Append F
                       End If
                       If rsB!FeldTyp = "dbMemo" Then
                                Set F = New Field
                                With F
                               .Name = rsB!Feldname
                               .Type = dbMemo
                               End With
                               T.Fields.Append F
                                                                                 
                              
                             Set prp = F.CreateProperty("TextFormat", dbByte, CByte(acTextFormatHTMLRichText))
                              F.Properties.Append prp 'Fehlermeldung 3219: Unzulässige Operation
                              Set prp = Nothing
                      
                    End If
                  End If
                rsB.MoveNext
                Loop
        
        rsB.MoveFirst
       
    rsA.MoveNext
    Loop


    rsA.Close
    Set rsA = Nothing
    Set db = Nothing
    rsB.Close
    Set rsB = Nothing
    Set prp = Nothing
    Set BE_TEST = Nothing
    'Zum Schluss wieder Durchlauf
    TabellenEinbindenBeispielaufruf
    End Function

    Donnerstag, 25. August 2011 12:24