从 VBA 记录集创建数组

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 提供的指导方向的评论 -> 这是我能够想出的语法，它完成了我所追求的。 （需要添加错误处理，但这是第一次运行）

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