I have a data entry program for field (no network - marine research) use. When the user gets back to the office they submit the data to the server for import into the master sql database. It then creates an empty access database file and exports the tables (DoCmd.TransferDatabase) so the user has a local copy for their offsite research purposes. What I am trying to do is recreate the table relationships in the new data file using DAO.Database.CreateRelation(). It works until I get to a table that needs two fields as a PK or FK.
Table1 Table2 Table3
SampleNumber 1--------M SampleNumber 1--------M SampleNumber
. LineNumber 1--------M LineNumber
. . HookNumber
. . .
. . .
Table1_PK -> SampleNumber
Table2_PK -> SampleNumber+LineNumber
Table3_PK -> SampleNumber+LineNumber+HookNumber
When I use this in my function:
Set newRelation = db.CreateRelation(relationUniqueName, _
primaryTableName, foreignTableName, relAttr)
it returns an error:
3001: Invalid argument.
But only when I try to create the above relationships. All other relationships create correctly.
Is there a way to do this, or should I just not worry about it and let them figure it out?
If you're looking to create a Relationship like this:
then you should be able to do it like this:
Dim cdb As DAO.Database, rel As DAO.Relation, fld As DAO.Field
Set cdb = CurrentDb
Set rel = cdb.CreateRelation("Table2Table3", "Table2", "Table3")
Set fld = New DAO.Field
fld.Name = "SampleNumber"
fld.ForeignName = "SampleNumber"
rel.Fields.Append fld
Set fld = New DAO.Field
fld.Name = "LineNumber"
fld.ForeignName = "LineNumber"
rel.Fields.Append fld
cdb.Relations.Append rel
Set fld = Nothing
Set rel = Nothing
Set cdb = Nothing
Related
I have problems with the Excel appand the program I tryin' to put together sends me a message that a document is been used.
In a form on Visual Foxpro 8, I collect some info from the tables of a db and then I assemble a worksheet with this elements.
Lately i've been testin' this part of the program but it shows me the message after it's done assemble the worksheet that the document is still been used, and on the task manager I see that the app is still running even that in the procedure there's a line telling that the Excel sheet is released.
with thisform
lcDir = "C:\Documents\PRGT\test.xls"
ExcelSheet=createobject("Excel.application")
ExcelSheet.APPLICATION.workbooks.ADD
ExcelSheet.APPLICATION.activesheet.cells(1,1).value = "info1"
ExcelSheet.APPLICATION.activesheet.cells(1,2).value = "info2"
ExcelSheet.APPLICATION.activesheet.cells(1,3).value = "info3"
ExcelSheet.APPLICATION.activesheet.cells(1,4).value = "info4"
local lnRow
store 0 to lnRow
select cursorName
go top
do while !eof()
ExcelSheet.Columns("A").Select
ExcelSheet.Selection.value = cursorName.a
ExcelSheet.Columns("B").Select
ExcelSheet.Selection.value = cursorName.b
ExcelSheet.Columns("C").Select
ExcelSheet.Selection.value = cursorName.c
ExcelSheet.Columns("D").Select
ExcelSheet.Selection.value = cursorName.d
lnRow = lnRow+1
selelect cursorName
skip
enddo
ExcelSheet.APPLICATION.activeworkbook.saveas(lcDir)
ExcelSheet.APPLICATION.visible = .f.
release ExcelSheet
/*
* some instruction to close the app
*/
endwith
Well, i found in a Visual forum that the next instruction work ExcelSheet.quit(.f.)
and I tried that line and when I was testing the program it couldn't do the procedure of assemble the excel and savin' it.
Any ideas I can try will be welcome and also it would help me to learn better about this
I couldn't understand some parts of your code, like:
lnRow = lnRow + 1 && not used at all
and selecting the Columns("A"). Why would you select the column? Wouldn't it be a Cell?
Though the way you are doing it is not suggested at all, to make it work correctly you could write as:
#Define xlWorkbookNormal -4143
LOCAL lcDir
lcDir = "C:\Documents\PRGT\test.xls"
Local excelsheet
excelsheet=Createobject("Excel.application")
With excelsheet
.DisplayAlerts = .F.
.workbooks.Add()
With .ActiveWorkBook.ActiveSheet
.cells(1,1).Value = "info1"
.cells(1,2).Value = "info2"
.cells(1,3).Value = "info3"
.cells(1,4).Value = "info4"
Select cursorName
Scan
.cells(Recno()+1,1).Value = cursorName.a
.cells(Recno()+1,2).Value = cursorName.b
.cells(Recno()+1,3).Value = cursorName.c
.cells(Recno()+1,4).Value = cursorName.d
Endscan
Endwith
.ActiveWorkBook.SaveAs(m.lcDir,xlWorkbookNormal)
.ActiveWorkBook.Saved = .T.
.Quit()
Endwith
In your code, you were setting excelSheet (which is the same as excelSheet.Application) .Visible to .F. and releasing ExcelSheet.
Setting it to Visible = .F. and releasing only the variable doesn't help, Excel instance would be left behind hidden with a lock on the document you created. You shouldn't set it to Visible=.F. but simply call Quit() method. Then also using your ExcelSheet variable local would release it by default, going out of scope.
After having said that, proper way of copying data to excel is not like this and this would be the slowest way to do that (don't try with lots of rows and columns data).
Instead you could send the data to excel using OLEDB and just use CopyFromRecordset method (using one of the variations of VFP2Excel routine that I have posted many times to many forums). ie: This sample sends 2 cursors to excel, to apply it to yourself all you need is to create your cursor(s) and set the laInfo[] accordingly to pass to "SaveCursorsToExcel":
* Our sample cursor(s)
Select Cust_Id, Company, Contact, Country From (_samples + 'data\Customer') Into Cursor crsCustomers nofilter
Select Order_Id, Cust_Id, Order_Date, Shipped_on From (_samples + 'data\Orders') Into Cursor crsOrders nofilter
Local Array laInfo[2, 3]
laInfo[1,1] = 'crsCustomers'
laInfo[1,2] = 'Customer Id,Company,Contact Name,Country' && Headers
laInfo[1,3] = 'Customers' && Sheet name
laInfo[2,1] = 'crsOrders'
laInfo[2,2] = 'Order Id, Customer Id, Order Date, Shipped On'
laInfo[2,3] = 'Orders'
Local lcSaveFilename
lcSaveFilename = "c:\temp\SampleExcelFile.xlsx"
SaveCursorsToExcel(#laInfo, m.lcSaveFilename)
Procedure SaveCursorsToExcel(taInfo, tcSaveAs)
External Array taInfo
*** We need real tables on disk to get them via VFPOLEDB
*** Assuming that there may be LFN in cursor data we create a temp DBC too
Local lcDbc, ix
lcDbc = Forcepath( Forceext( Sys(2015), 'dbc'), Sys(2023))
** Create the temp dbc
Create Database (m.lcDbc)
** and set it as the default database
Set Database To (m.lcDbc)
** and create tables from cursors as part of this new dbc
*** We could send many cursors to Excel at one go.
*** taInfo passes the information of cursornames to send and their headers
Local Array laTableNames[ALEN(taInfo,1)]
For ix = 1 To Alen(laTableNames)
laTableNames[m.ix] = Forcepath( Forceext(Sys(2015), 'dbf'), Sys(2023))
Select * From (taInfo[m.ix,1]) Into Table (m.laTableNames[m.ix]) Database (m.lcDbc)
Use In (Select(Juststem(m.laTableNames[m.ix])))
Endfor
Close Database
** Ready for sending the data to excel
** We also assume that the Excel on this machine could be a 64 bit version
** thus we don't do a direct VFPOLEDB transfer but wrap it in a ADODB.Stream
** We could as well use an ADODB.RecordSet
Local Array laStream[ALEN(taInfo,1)]
Local ix
For ix = 1 To Alen(taInfo,1)
laStream[m.ix] = GetDataAsAdoStream("Provider=VFPOLEDB;Data Source="+m.lcDbc, Textmerge("select * from ('<< m.laTableNames[m.ix] >>')"))
Endfor
*** Now that we have the data in streams, we can get rid of the temp database and tables
Local lcSafety
lcSafety = Set("Safety")
Set Safety Off
Delete Database (m.lcDbc) Deletetables
Set Safety &lcSafety
*** Main Excel automation part now
oExcel = Createobject("Excel.Application")
With oExcel
.DisplayAlerts = .F.
.Workbooks.Add
* .Visible = .T.
With .ActiveWorkBook
For ix = 1 To Alen(taInfo,1)
If .sheets.Count < m.ix
.sheets.Add(,.sheets(.sheets.Count)) && Add new sheet
Endif
.WorkSheets(m.ix).Name = taInfo[m.ix,3]
* Send the data - copy to replacement
VFP2ExcelVariation(m.laStream[m.ix], .WorkSheets[m.ix].Range("A1"), taInfo[m.ix,2])
.WorkSheets(m.ix).Columns.AutoFit()
Endfor
.WorkSheets(1).Activate
Endwith
.ActiveWorkBook.SaveAs(m.tcSaveAs)
.ActiveWorkBook.Saved = .T.
.Quit()
Endwith
ENDPROC
Function VFP2ExcelVariation(toStream, toRange, tcHeaders)
Local loRS As AdoDb.Recordset,ix
loRS = Createobject('Adodb.Recordset')
m.loRS.Open( m.toStream )
* Use first row for headers
Local Array aHeader[1]
m.toRange.Offset(1,0).CopyFromRecordSet( m.loRS ) && Copy data starting from headerrow + 1
For ix=1 To Iif( !Empty(m.tcHeaders), ;
ALINES(aHeader, m.tcHeaders,1,','), ;
m.loRS.Fields.Count )
m.toRange.Offset(0,m.ix-1).Value = ;
Iif( !Empty(m.tcHeaders), ;
aHeader[m.ix], ;
Proper(m.loRS.Fields(m.ix-1).Name) )
m.toRange.Offset(0,m.ix-1).Font.Bold = .T.
Endfor
m.loRS.Close()
Endfunc
Procedure GetDataAsAdoStream(tcConnection, tcSQL)
Local loStream As 'AdoDb.Stream', ;
loConn As 'AdoDb.Connection', ;
loRS As 'AdoDb.Recordset'
loStream = Createobject('AdoDb.Stream')
loConn = Createobject("Adodb.connection")
loConn.ConnectionString = m.tcConnection
m.loConn.Open()
loRS = loConn.Execute(m.tcSQL)
m.loRS.Save( loStream )
m.loRS.Close
m.loConn.Close
Return m.loStream
Endproc
At first no need to put your code in with thisform and endwith block as here you are not specifying properties of a form object.
The Excel file name extension prefered to be "xlsx" not "xls" if you are using a new version of Excel.
It's better to define lcDir as local as you did with the lnRow so you need to add local lcDir before store 0 to lnRow.
Regarding the loop through records it's better and easier to replace :
select cursorName
go top
do while !eof()
.
.
.
select cursorName
skip
enddo
By
select cursorName
scan
.
.
.
endscan
To export the records data to the Excel workbook rows, use the same method you used to export the header of the columns but change the row number for each record using the lnRow variable you already defined, but initiate it's value by 2 at first rather than 0 by replacing store 0 to lnRow by store 2 to lnRow
And replace :
ExcelSheet.Columns("A").Select
ExcelSheet.Selection.value = cursorName.a
ExcelSheet.Columns("B").Select
ExcelSheet.Selection.value = cursorName.b
ExcelSheet.Columns("C").Select
ExcelSheet.Selection.value = cursorName.c
ExcelSheet.Columns("D").Select
ExcelSheet.Selection.value = cursorName.d
By :
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,1).value = cursorName.a
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,2).value = cursorName.b
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,3).value = cursorName.c
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,4).value = cursorName.d
After saving the workbook you need only to quit the Excel as you stated by using ExcelSheet.quit and no need to make the Excel hidden, so no need for ExcelSheet.APPLICATION.visible = .f.
So the complete code will look like:
local lcDir
lcDir = "C:\Documents\PRGT\test.xlsx"
ExcelSheet=createobject("Excel.application")
ExcelSheet.APPLICATION.workbooks.ADD()
ExcelSheet.APPLICATION.activesheet.cells(1,1).value = "info1"
ExcelSheet.APPLICATION.activesheet.cells(1,2).value = "info2"
ExcelSheet.APPLICATION.activesheet.cells(1,3).value = "info3"
ExcelSheet.APPLICATION.activesheet.cells(1,4).value = "info4"
local lnRow
store 2 to lnRow
select cursorName
scan
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,1).value = cursorName.a
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,2).value = cursorName.b
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,3).value = cursorName.c
ExcelSheet.APPLICATION.activesheet.cells(lnRow ,4).value = cursorName.d
lnRow = lnRow+1
endscan
ExcelSheet.APPLICATION.activeworkbook.saveas(lcDir)
ExcelSheet.quit()
release ExcelSheet
I have an excel workbook consisting of a source data and a pivot table.
the source data gets updated with new records daily along with some changes in the existing data.
I have written a vbscript in notepad and saved it with .vbs and I am calling it from Rstudio to perform the refresh pivot table action.
But,when I run this script in Rstuido :
pathofvbscript = ("D:\\Users\\703225799\\WIP\\R\\pivot\\r5.vbs")
shell(shQuote(normalizePath(pathofvbscript)),"cscript",flag =
"//nologo")
I am getting the following error :
D:\Users\703225799\WIP\R\pivot\r5.vbs(14, 1) Microsoft VBScript runtime
error: Object doesn't support this property or method: 'objWB.Range'
VBS code :
'------------------------------------------------------------------------
'Set Pivot Table & Source Worksheet
'------------------------------------------------------------------------
Set objExcel = CreateObject("Excel.Application")
Set objWB =
objExcel.Workbooks.Open("D:\Users\703225799\WIP\R\pivot\New
folder\Book1.xlsx")
Set Pivot_Sheet = objWB.Worksheets("pvt")
'-----------------------------------------------------------------------
'Enter in Pivot Table Name
'-----------------------------------------------------------------------
PivotName = "PivotTable1"
objWB.Activate
Set StartPoint = objWB.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
New_range = objWB.Name & "!" & DataRange.Address(xlR1C1)
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(xlDatabase,NewRange)
'----------------------------------------------------------------------
'Ensure Pivot Table is Refreshed
'----------------------------------------------------------------------
Pivot_Sheet.PivotTables(PivotName).RefreshTable
'Data_Sheet.Save
'MsgBox "Your Pivot Table is now saved."
'Data_Sheet.Close
'MsgBox "Your Pivot Table is now closed."
'objExcel.Quit
'MsgBox "objExcel quit."
'----------------------------------------------------------------------
'Complete Message
'----------------------------------------------------------------------
Pivot_Sheet.Activate
MsgBox "Your Pivot Table is now updated."
objWB.Save
objWB.Close
set objExcel = Nothing
set Data_Sheet = Nothing
Set Pivot_Sheet = Nothing
Please help with the error.
Thanks,
Sayan
Please try using Pivot_Sheet.Range("A1") instead of objWB.Range("A1") as the worksheet object is Pivot_sheet
Hi Everyone I am having trouble getting a ComboBox to sort, when another combobox is selected.
I think I have the Right SQL Syntax but I cant seem to get the vba to run it through; currently the vba returns all of the states in the recordset regardless of the company.
Private Sub CboCountry_Click()
Set db = CurrentDb
Dim SQLStr As String
Set RsState = db.OpenRecordset("T2States", dbOpenSnapshot, dbSeeChanges)
'populates combobox with recordset, that is defined by the country input from the form
RsState.MoveFirst
Do While Not RsState.EOF
Me.CboState.RowSource = Me.CboState.RowSource & RsState("StateID") & ";" & RsState("State") & ";"
RsState.MoveNext
Loop
I think this is the right SQL String but I'm having trouble to get it to work.
'SQLStr = "SELECT T2States.StateID, T2States.States, T2States.CountryID" & _
" FROM T2States GROUP BY T2States.StatesID" & _
" WHERE T2States.CountryID = """ & Me.CboCountry.Value & """"
Any help will be greatly appreciated.
Edit#1
See Full Code below, the error that pops up when I substitute SQLStr into the Openrecordset is a Run-time error '3078' the microsoft access database engine cannot find the input table or query 'SQLStr'. Make sure it exists and that its name is spelled correctly.
What should happen is when a country is selected from CboCountry combobox, it will load the CboState combobox by sorting the recordset by CountryID
see below for both code parts
Private Sub Form_Load()
Set db = CurrentDb
Set RsCompany = db.OpenRecordset("T1Company", dbOpenDynaset, dbSeeChanges)
Set RsCountry = db.OpenRecordset("T2Countries", dbOpenSnapshot, dbSeeChanges)
Set RsAddress = db.OpenRecordset("T1Addresses", dbOpenDynaset, dbSeeChanges)
Set RsAddressType = db.OpenRecordset("T2AddressType", dbOpenSnapshot, dbSeeChanges)
Set RsCompanyAddress = db.OpenRecordset("T3Company_Address", dbOpenDynaset, dbSeeChanges)
Me.CboCountry = Null
Me.TxtAddress1 = Null
Me.TxtAddress2 = Null
Me.TxtAddress3 = Null
Me.TxtCity = Null
Me.CboAddressType = Null
Me.CboCountry = Null
Me.CboState = Null
Me.TxtPostalCode = Null
Me.TxtCompanyID = Null
Me.TxtLegalName = Null
Me.TxtNickname = Null
Me.TxtAddressID = Null
RsCountry.MoveFirst
Do While Not RsCountry.EOF
Me.CboCountry.RowSource = Me.CboCountry.RowSource & RsCountry("CountryID") & ";" & RsCountry("Country") & ";"
RsCountry.MoveNext
Loop
RsAddressType.MoveFirst
Do While Not RsAddressType.EOF
Me.CboAddressType.RowSource = Me.CboAddressType.RowSource & RsAddressType("AddressTypeID") & ";" & RsAddressType("AddressType") & ";"
RsAddressType.MoveNext
Loop
Me.TxtLegalName.SetFocus
End Sub
Private Sub CboCountry_Click()
Set db = CurrentDb
Dim SQLStr As String
'SQLStr = "SELECT T2States.StateID, T2States.State, T2States.CountryID" & _
" FROM T2States" & _
" WHERE T2States.CountryID = """ & Me.CboCountry.Value & """"
Set RsState = db.OpenRecordset("T2States", dbOpenDynaset, dbSeeChanges)
'populates combobox with recordset, that is defined by the country input from the form
RsState.MoveFirst
Do While Not RsState.EOF
Me.CboState.RowSource = Me.CboState.RowSource & RsState("StateID") & ";" & RsState("State") & ";"
RsState.MoveNext
Loop
End Sub
Let us see
1- sure you've to append with
Having T2States.States, T2States.CountryID
2- Error exist in it, extra 's' in the Column name:
GROUP BY T2States.StatesID
3- put all the code and i'll check with you what you miss.
best regards
This one turned out to be a quick fix in the Property Sheet under the DATA tab, the Row Source Type had to be changed back to 'Table/Query' from a 'Value'.
There is VBA that could account for this but it was just a simple as changing that Row Source.
The Reason for the mix up, for a quick bit of background if it helps, is that all my combo boxes are unbound and I was binding them with VBA Recordsets so the rowsource has to be a value list - Essentially the VBA is writing the list everytime it loads.
Where as when I started using SQL to generate the recordset, even though it was in VBA I had to change the property back to Table/Query.
Thanks.
I'm trying to add records to an exisiting table called "Topics" (section as of "For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected" in the code below).
When executing the code i always get "Run-time error '3022': The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. So it goes wrong at the creation of the Autonumber in the field "ID" (= the only field that is indexed - no duplicates).
When debugging, line "TopicRecord.Update" in the code below is highlighted.
I have read several posts on this topic on this forum and on other forums but still cannot get this to work - i must be overlooking something....
Private Sub Copy_Click()
Dim JournalEntrySourceRecord, JournalEntryDestinationRecord, TopicRecord As Recordset
Dim JournalEntryToCopyFromCtl, JournalEntryToCopyToCtl, JournalEntryDateCreatedCtl, SelectedTopicsCtl As Control
Dim Counter, intI As Integer
Dim SelectedTopic, varItm As Variant
Set JournalEntryToCopyFromCtl = Forms![Copy Journal Entry]!JournalEntryToCopyFrom
Set JournalEntryToCopyToCtl = Forms![Copy Journal Entry]!JournalEntryToCopyTo
Set JournalEntryDateCreatedCtl = Forms![Copy Journal Entry]!JournalEntryDateCreated
Set JournalEntrySourceRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyFromCtl.Value)
Set JournalEntryDestinationRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyToCtl.Value)
Set SelectedTopicsCtl = Forms![Copy Journal Entry]!TopicsToCopy
Set TopicRecord = CurrentDb.OpenRecordset("Topics", dbOpenDynaset, dbSeeChanges)
With JournalEntryDestinationRecord
.Edit
.Fields("InitiativeID") = JournalEntrySourceRecord.Fields("InitiativeID")
.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
.Fields("Comment") = JournalEntrySourceRecord.Fields("Comment")
.Fields("Active") = "True"
.Fields("InternalOnly") = JournalEntrySourceRecord.Fields("InternalOnly")
.Fields("Confidential") = JournalEntrySourceRecord.Fields("Confidential")
.Update
.Close
End With
JournalEntrySourceRecord.Close
Set JournalEntrySourceRecord = Nothing
Set JournalEntryDestinationRecord = Nothing
For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected
TopicRecord.AddNew
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter) = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Next Counter
TopicRecord.Fields("JournalEntryID") = JournalEntryToCopyToCtl.Value
TopicRecord.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
TopicRecord.Update
Next SelectedTopic
TopicRecord.Close
Set TopicRecord = Nothing
End Sub
First, your Dims won't work as you expect. Use:
Dim JournalEntrySourceRecord As Recordset
Dim JournalEntryDestinationRecord As Recordset
Dim TopicRecord As Recordset
Second, it looks like you get your ID included here:
TopicRecord.Fields(Counter)
or Topic is a query that includes it somehow. Try to specify the fields specifically and/or debug like this:
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter).Value = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Debug.Print Counter, TopicRecord.Fields(Counter).Name
Next Counter
Since I received so nice and fast solution to my problem, I will try again to get some help from you:
I opened two Recordsets.
Set cmd1.ActiveConnection = cn1
cmd1.CommandText = "SELECT * FROM mov Where [Date] >= #" & DateA & "#;"
Set RSold = cmd1.Execute
Set cmd2.ActiveConnection = cn2
cmd2.CommandText = "SELECT * FROM mov"
Set RSnew = cmd2.Execute
(I want to save only selected records of a file.)
I know how to copy record by record, but is there a 'Short Cut' to do it faster ?
Thanks
try this:
Dim i As Long
Do While Not RSold.EOF
' You can place if condition here
RSNew.AddNew
For i = 0 To RSold.Fields.Count - 1
RSNew.Fields(RSold.Fields(i).Name) = RSold.Fields(i).Value
Next i
RSNew.Update
RSold.MoveNext
Loop
This will copy records from RSold to RSnew recordset
You Can use code :
Set RSNew = RSOld.Clone
#user1838163 :Saving the second Recordset as a file
Dim RFileNm As String
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
RFileNm = "c:\temp\" & Trim(RFileNm) & ".adt"
fs.DeleteFile (RFileNm)
RSNew .Save RFileNm, adPersistADTG
RSNew .Close
RSNew .Open RFileNm, , , , adCmdFile
I think this will do what you want by doing it all at once.
Dim objPB As New PropertyBag
objPB.WriteProperty "rs", RSOld
Set RSNew = objPB.ReadProperty("rs")
Set objPB = Nothing
I don't think CLONE is going to do what you want. It just gives you another view of the same recordset you already have. This allows you to use multiple bookmarks and so forth, but the recordset is still attached to the same database the original was. I also need a way to copy the recordset and save it to a new database in a new format.