从VBA记录集创建数组

问题描述：

我需要填充符合我的IF语句中条件的字段的VBA数组。我无法围绕创建记录集中的数组进行包装，它看起来像一个完全不同于我的“普通”数组的世界。以下是我有：从VBA记录集创建数组

从记录移动到数组，你可以使用简单的方法：'rs2.GetRows（）'。但是，首先您需要根据SQL查询创建正确的记录集结果，您可以在其中排除“ID字段”和其他“文本类型”。 –

@KazimierzJawor - 比我最初想象的还要大。感谢您张贴，以允许我的谷歌的起点:) –

这里真的*新鲜*答案：http://stackoverflow.com/questions/41485788/dynamically-populate-vba-array/41486069#41486069 –

答

您可以使用下面的函数来生成提取你想要什么，然后可以从该.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

这看起来像一个很好的函数，但在这个项目中，我非常依赖DAO，我不相信你可以在一个数据库上同时使用ADO和DAO。 Def保存到文本文件以供稍后存储:) –

您可以同时执行这两个操作，我的前缀为ADODB类名称，表示您的表格有100个字段，全部为非文本，您的方法将执行100次插入每行。看看这个，一个SQL操作，不管你是在DAO runsql还是ADO的execute上运行。 http://www.w3schools.com/sql/sql_insert_into_select.asp –

答

由于注释提供关于在由@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

从VBA记录集创建数组

相关推荐