Option Compare Database

Option Explicit

 

Sub Fix_Memo()

    Dim db As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field

    Set db = CurrentDb

    '

    Open "C:\BILL\SQL_Memo_Fixup.sql" For Output As #1

    Print #1, "-- change all Memo fields from nvarchar(max) to nvarchar(4000)"

    Print #1, "-- "; Format(Now(), "ddd mmm d, yyyy")

    Print #1, ""

    '

       For Each tdf In db.TableDefs

              If Left(tdf.Name, 4) <> "MSys" Then

                     For Each fld In tdf.Fields

                           If fld.Type = dbMemo Then

                                  Fix_Memo_Single tdf.Name, fld.Name

                           End If

                     Next fld

              End If

       Next tdf

    Close #1

    Set db = Nothing

End Sub

 

Sub Fix_Memo_Single(MyTable As String, MyField As String)

    Print #1, "ALTER TABLE dbo."; MyTable; " ADD Tmp_"; MyField; " nvarchar(4000) NULL"

    Print #1, "GO"

    Print #1, "UPDATE dbo."; MyTable; " SET Tmp_"; MyField; " = CONVERT(nvarchar(4000), "; MyField; ")"

    Print #1, "ALTER TABLE dbo."; MyTable; " DROP COLUMN "; MyField

    Print #1, "GO"

    Print #1, "EXECUTE sp_rename N'dbo."; MyTable; ".Tmp_"; MyField; "', N'"; MyField; "', 'COLUMN' "

    Print #1, "GO"

    Print #1, ""

End Sub