Question

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

1）Debug.Print fld.Name打印正确的字段naem
2）Debug.Print SecondSQL打印有效＆amp;正确的SQL语法（如果我在查询中运行它会动态地改变表格）

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

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执行更改表声明

1 个答案: