Question

我需要使用符合IF语句中条件的字段填充VBA数组。我无法用记录集创建数组，这对我来说似乎是一个完全不同于“普通”数组的世界。这就是我所拥有的：

Function AlterTable()

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  
    'Populate Array Here
  End If
End If
Next

Set fld = Nothing
rs2.Close

End Function

Answer 1

感谢评论提供了关于@KazimierzJawor的指导方向 - ＆gt; 这就是我能够想出的语法，完成了我所追求的目标。（需要添加错误处理，但这是第一次运行）

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

Answer 2

Dim colNames() As Variant
colNames = Array("Employee", "Client")
'rs.MoveFirst
Dim data() As Variant ' Two dimensional array
data = rs.GetRows(Fields:=colNames)
' data(0,5) is Employee for 6th row in recordset

Answer 3

您可以使用以下函数生成提取所需内容所需的SQL，然后使用.GetRows()。它使用ADO，因此您需要添加对ADO的引用。基于以上所述，您可以使用它来生成INSERT INTO from (function return)

类似于docmd.runsql "INSERT INTO tbl_TEST_Clone " & GEN_SQL_TABLE("tbl_test")

Option Explicit

Function GEN_SQL_TABLE(strTableName As String) As String

Dim r As New ADODB.Recordset
Dim rKeys As New ADODB.Recordset

Set r = CurrentProject.Connection.OpenSchema(adSchemaColumns, _
                Array(Empty, Empty, strTableName, Empty))

r.Filter = "[DATA_TYPE]<>" & adWChar

Set rKeys = CurrentProject.Connection.OpenSchema(adSchemaPrimaryKeys, _
        Array(Empty, Empty, strTableName))

While Not r.EOF
    If Not rKeys.BOF Then rKeys.MoveFirst
    rKeys.Filter = "[COLUMN_NAME]='" & r.Fields("COLUMN_NAME").value & "'"
    If rKeys.EOF Then
        GEN_SQL_TABLE = _
            GEN_SQL_TABLE & IIf(Len(GEN_SQL_TABLE) > 0, ",", "") & _
            r.Fields("COLUMN_NAME").value
    End If
    rKeys.Filter=""
    r.MoveNext
Wend

GEN_SQL_TABLE = "SELECT " & GEN_SQL_TABLE & " FROM " & strTableName

r.Close
rKeys.Close

Set r = Nothing
Set rKeys = Nothing

End Function

从VBA Recordset创建数组

3 个答案: