CODEWITHSUNDEEP
vbams-accessvbscript
S.Imthorn
S.Imthorn

Reputation: 1

Access change memo field from "plain text" to "rich text" using VBScript

i have a question about changing a memofield from "plain text" to "rich text" using VBScript, i found some solutions here and on the internet but all the solutions are for VBScript within access. I try to start an vbscript through Windows, but my script doesn't work. I'm kindly new to VBScripting so i hope you guys can help me. I used an example from the forum for my script: How to convert a text field in an Access table to a rich text memo using VBA

My Script:

Dim db
Dim tdf
Dim fld1
Dim fld2
Set accessApp = GetObject("D:\test.mdb")
Set accessApp = CreateObject("Access.Application")
    accessApp.OpenCurrentDataBase "D:\test.mdb", true
    accessApp.visible = false
    accessApp.UserControl = true 

Set accessApp.db =  CurrentDB
Set accessApp.tdf = db.TableDefs("Database")
Set accessApp.fld1 = tdf.Fields("Name_Memofield1")
Set accessApp.fld2 = tdf.Fields("Name_Memofield2")
Debug.Print "acTextFormatPlain: " & acTextFormatPlain & _
    "; acTextFormatHTMLRichText: " & acTextFormatHTMLRichText
With fld1.Properties("TextFormat")
    Debug.Print "TextFormat: " & .Value
    If .Value = acTextFormatPlain Then
        .Value = acTextFormatHTMLRichText
        Debug.Print "TextFormat changed to: " & .Value
    End If
End With    
With fld2.Properties("TextFormat")
    Debug.Print "TextFormat: " & .Value
    If .Value = acTextFormatPlain Then
        .Value = acTextFormatHTMLRichText
        Debug.Print "TextFormat changed to: " & .Value
    End If
End With

The error what occures tells me that the problem is in the "Set accessApp.db = CurrentDB" the error which occured is: "Object doesn't support this prperty or method accessApp.db" If i change "accessApp.db" to "db" an other error occures: "Object required: 'CurrentDB' "

Upvotes: 0

Views: 1825

Answers (1)

Fionnuala
Fionnuala

Reputation: 91326

Try something like the code below. It will need tidying.

Option Explicit

Dim accessApp
Dim db
Dim dbname
Dim tdf
Dim fld1
Dim fld2
Dim acTextFormatPlain
Dim acTextFormatHTMLRichText
Dim dbInteger

'acTextFormatPlain=0
'acTextFormatHTMLRichText=1
dbInteger=3

dbname="D:\Test.mdb"

Set accessApp = CreateObject("Access.Application")
accessApp.OpenCurrentDataBase(dbname)

set db=accessapp.CurrentDb

Set tdf = db.TableDefs("2emails")

'The property may not exist
SetFieldProperty tdf.Fields(1), "TextFormat", dbInteger, 0
With tdf.Fields(1).Properties("TextFormat")
    If .Value = 0 Then
        .Value = 1
        msgbox "TextFormat changed to: " & .Value
    End If
End With

Sub SetFieldProperty(ByVal fld , ByVal strPropertyName , ByVal iDataType , ByVal vValue )
    Dim prp

    Set prp = Nothing

    On Error Resume Next
    Set prp = fld.Properties(strPropertyName)
    On Error GoTo 0

    If prp Is Nothing Then
        Set prp = fld.CreateProperty(strPropertyName, iDataType, vValue)
        fld.Properties.Append prp 
    Else
        prp.Value = vValue
    End If
End Sub

Upvotes: 1

Related Questions