VBA 执行 Alter Table 语句

Question

我正在尝试通过 VBA 执行 Alter Table 语句。我使用函数 Allen Brown Table Info() 来获取字段类型，而这个 VBA 实际上是运行 SQL Sytnax。这是我的问题：

1) Debug.Print fld.Name prints the correct field naem
2) Debug.Print SecondSQL prints valid & correct SQL Syntax (if I run in a query it actaully alters the table)

为了让 VBA 语法改变 table 我应该改变什么？

Function AlterTable()
Dim secondSQL As String
Set rs2 = db.OpenRecordset("___TestTable")
For Each fld In rs2.Fields
If fld.Name <> "ID" Then
    If FieldTypeName(fld) <> "Text" Then
        Debug.Print fld.Name            
        secondSQL = "ALTER TABLE ___TestTable ALTER COLUMN [" & fld.Name & "] TEXT(40);"
        Debug.Print secondSQL
        DoCmd.RunSQL secondSQL
    End If
End If
Next

'Disposing of Objects
Set fld = Nothing
rs2.Close

End Function


Function FieldTypeName(fld As DAO.Field) As String
'Purpose: Converts the numeric results of DAO Field.Type to text.
Dim strReturn As String    'Name to return

Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long.
    Case dbBoolean: strReturn = "Yes/No"            ' 1
    Case dbByte: strReturn = "Byte"                 ' 2
    Case dbInteger: strReturn = "Integer"           ' 3
    Case dbLong                                     ' 4
        If (fld.Attributes And dbAutoIncrField) = 0& Then
            strReturn = "Long Integer"
        Else
            strReturn = "AutoNumber"
        End If
    Case dbCurrency: strReturn = "Currency"         ' 5
    Case dbSingle: strReturn = "Single"             ' 6
    Case dbDouble: strReturn = "Double"             ' 7
    Case dbDate: strReturn = "Date/Time"            ' 8
    Case dbBinary: strReturn = "Binary"             ' 9 (no interface)
    Case dbText                                     '10
        If (fld.Attributes And dbFixedField) = 0& Then
            strReturn = "Text"
        Else
            strReturn = "Text (fixed width)"        '(no interface)
        End If
    Case dbLongBinary: strReturn = "OLE Object"     '11
    Case dbMemo                                     '12
        If (fld.Attributes And dbHyperlinkField) = 0& Then
            strReturn = "Memo"
        Else
            strReturn = "Hyperlink"
        End If
    Case dbGUID: strReturn = "GUID"                 '15

    'Attached tables only: cannot create these in JET.
    Case dbBigInt: strReturn = "Big Integer"        '16
    Case dbVarBinary: strReturn = "VarBinary"       '17
    Case dbChar: strReturn = "Char"                 '18
    Case dbNumeric: strReturn = "Numeric"           '19
    Case dbDecimal: strReturn = "Decimal"           '20
    Case dbFloat: strReturn = "Float"               '21
    Case dbTime: strReturn = "Time"                 '22
    Case dbTimeStamp: strReturn = "Time Stamp"      '23

    'Constants for complex types don't work prior to Access 2007 and later.
    Case 101&: strReturn = "Attachment"         'dbAttachment
    Case 102&: strReturn = "Complex Byte"       'dbComplexByte
    Case 103&: strReturn = "Complex Integer"    'dbComplexInteger
    Case 104&: strReturn = "Complex Long"       'dbComplexLong
    Case 105&: strReturn = "Complex Single"     'dbComplexSingle
    Case 106&: strReturn = "Complex Double"     'dbComplexDouble
    Case 107&: strReturn = "Complex GUID"       'dbComplexGUID
    Case 108&: strReturn = "Complex Decimal"    'dbComplexDecimal
    Case 109&: strReturn = "Complex Text"       'dbComplexText
    Case Else: strReturn = "Field type " & fld.Type & " unknown"
End Select

FieldTypeName = strReturn
End Function

Answer 1

看起来@Johnny Bones 的语法声明是正确的，因为它是开放的。我改变了语法并使用它，它完全按照它应该的方式工作。可能不是最好的语法，def 需要一些错误处理，但它现在可以工作了！

Function Blue()
Dim CreateTableSQL As String
Dim fld As DAO.Field
Set db = CurrentDb()

CreateTableSQL = "CREATE TABLE [GreenSocks] (FieldPK COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, fieldname TEXT);"
db.Execute CreateTableSQL

Set rs2 = db.OpenRecordset("___TestTable")
For Each fld In rs2.Fields
    If fld.Name <> "ID" And fld.Name <> "Store Number" Then
        If FieldTypeName(fld) <> "Text" Then
            Debug.Print fld.Name

                strSQL = "INSERT INTO GreenSocks (fieldname) VALUES ('" & fld.Name & "' );"
                DoCmd.RunSQL strSQL

        End If
    End If
Next

Set fld = Nothing
rs2.Close

strSQL = "select fieldname from GreenSocks"

Set rs3 = db.OpenRecordset(strSQL)
For Each fld In rs3.Fields

    Debug.Print fld.Value

    secondSQL = "ALTER TABLE __TestTable ALTER COLUMN [" & fld.Value & "] TEXT(40);"

    DoCmd.RunSQL secondSQL

 Next

  Set fld = Nothing
  rs3.Close

End Function

VBA 执行 Alter Table 语句

VBA To Execute Alter Table Statement

ms-access

vba

ms-access-2013