從VBA記錄集創建數組

Question

我需要填充符合我的IF語句中條件的字段的VBA數組。我無法圍繞創建記錄集中的數組進行包裝，它看起來像一個完全不同於我的「普通」數組的世界。以下是我有：

Answer 1

您可以使用下面的函數來生成提取你想要什麼，然後可以從該.GetRows()所需的SQL。它使用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 

Answer 2

由於註釋提供關於在由@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