2017-01-05 89 views
0

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

+3

從記錄移動到數組,你可以使用簡單的方法:'rs2.GetRows()'。但是,首先您需要根據SQL查詢創建正確的記錄集結果,您可以在其中排除「ID字段」和其他「文本類型」。 –

+0

@KazimierzJawor - 比我最初想象的還要大。感謝您張貼,以允許我的谷歌的起點:) –

+0

這裏真的*新鮮*答案:http://stackoverflow.com/questions/41485788/dynamically-populate-vba-array/41486069#41486069 –

回答

0

您可以使用下面的函數來生成提取你想要什麼,然後可以從該.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 
+0

這看起來像一個很好的函數,但在這個項目中,我非常依賴DAO,我不相信你可以在一個數據庫上同時使用ADO和DAO。 Def保存到文本文件以供稍後存儲:) –

+0

您可以同時執行這兩個操作,我的前綴爲ADODB類名稱,表示您的表格有100個字段,全部爲非文本,您的方法將執行100次插入每行。看看這個,一個SQL操作,不​​管你是在DAO runsql還是ADO的execute上運行。 http://www.w3schools.com/sql/sql_insert_into_select.asp –

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