dim rs as new adodb.recordset
dim i as integer
With rs
    With .Fields
        .Append  "IdNum" , adInteger
        .Append  "SomeValue" , adChar,  5 
    End With
    Set .ActiveConnection = Nothing
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .Open
    for i= 1  to  1000 
        .addnew
        !IdNum=i
        !SomeValue= "value_"  & cstr(i)
    next i
End With
rs.close
set rs=nothing

Dim rsOut As ADODB.Recordset
Set rsOut = New ADODB.Recordset
Set rsOut.ActiveConnection = Nothing
rsOut.CursorLocation = adUseClient
rsOut.CursorType = adOpenStatic
'rsOut.Fields.Append ID, adVarChar, 255
'rsOut.Fields.Append Name, adVarChar,  255 

rsOut.Open  "SELECT ID, Name FROM TblName, .....WHERE 1 = 0 " 
'Чтобы получить только структуру ,а не данные

'Dim i As Integer
Dim rsOutFieleCount As Integer
rsOutFieleCount = rsOut.Fields.Count
rsIn.MoveFirst
Do While Not rsIn.EOF
    rsOut.AddNew
'i = 0     'Зачем? у тебя всего два поля.
'    Do While i < rsOutFieleCount
'    rsOut(i) = rsIn(i)
'    i = i + 1
'    Loop
'rsOut.Update 'Зачем?Набор отсоединенный
   rsOut!Id=rsIn!Id
   rsOut!Name=rsIn!Name
   rsIn.MoveNext
Loop