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
Related
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
Is their any command in Foxpro that convert the DBF into a particular excel sheet.
I have three DBF(dbf_1, dbf_2, dbf_3). My current program convert the file using copy to "filename.xls" type fox2x and then I will manually copy the consolidate all the sheet into one excel. For me, this method I using is alright but what if their are 20 or more dbf that I will consolidate. Is their any command in foxpro that convert the dbf's into one excel file. I already use the foxpro Automation but it is to slow.
No there isn't.
Also "copy to ... type fox2x". although better than many other type selections (such as csv and xls) should not be chosen when there are better ways.
You are saying automation is slow, but don't know if you are really finding automation slow, or if you have tried it in the ways that you shouldn't use to transfer data to Excel. The sample below, use one of the variations of my "vfp2excel" function and automation. It transfers sample Customer, Employee, Orders, OrdItems and Products data in 2.5 seconds on my machine. If you really meant it as slow then no dice, otherwise here is the sample:
* These represent complex SQL as a sample
Select emp_id,First_Name,Last_Name,;
Title,Notes ;
from (_samples+'\data\employee') ;
into Cursor crsEmployee ;
readwrite
Replace All Notes With Chrtran(Notes,Chr(13)+Chr(10),Chr(10))
Select cust_id,company,contact,Title,country,postalcode ;
from (_samples+'\data\customer') ;
into Cursor crsCustomer ;
nofilter
Select * ;
from (_samples+'\data\orders') ;
into Cursor crsOrders ;
nofilter
Select * ;
from (_samples+'\data\orditems') ;
into Cursor crsOrderDetail ;
nofilter
Select * ;
from (_samples+'\data\products') ;
into Cursor crsProducts ;
nofilter
* Now we want to get these on 3 sheets
* Sheet1: Employees only
* Sheet2: Customers only
* Sheet3: Orders, ordItems, Products layed out horizontally
Local oExcel
oExcel = Createobject("Excel.Application")
With oExcel
.DisplayAlerts = .F.
.Workbooks.Add
.Visible = .T.
With .ActiveWorkBook
For ix = 1 To 3 && We want 3 Sheets
If .sheets.Count < m.ix
.sheets.Add(,.sheets(.sheets.Count)) && Add new sheets
Endif
Endfor
* Name the sheets
.WorkSheets(1).Name = "Employees"
.WorkSheets(2).Name = "Customers"
.WorkSheets(3).Name = "Order, OrderDetail, Products" && max sheetname is 31 chars
* Start sending data
* First one has headers specified
VFP2Excel('crsEmployee', .WorkSheets(1).Range("A1"), ;
"Id,First Name,Last Name,Employee Title,Comments about employee" ) && To sheet1, start at A1
VFP2Excel('crsCustomer', .WorkSheets(2).Range("A1") ) && To sheet2, start at A1
VFP2Excel('crsOrders', .WorkSheets(3).Range("A1") ) && To sheet3, start at A1
* Need to know where to put next
* Leave 2 columns empty - something like 'G1'
lcRange = _GetChar(.WorkSheets(3).UsedRange.Columns.Count + 3) + '1'
* To sheet3, start at next to previous
VFP2Excel('crsOrderDetail', .WorkSheets(3).Range(m.lcRange) )
lcRange = _GetChar(.WorkSheets(3).UsedRange.Columns.Count + 3) + '1'
* To sheet3, start at next to previous
VFP2Excel('crsProducts', .WorkSheets(3).Range(m.lcRange) )
#Define xlJustify -4130
#Define xlTop -4160
* I just happen to know notes in at column 5 from SQL
* No need to query from excel to keep code simple
* Lets format that column specially instead of leaving
* at the mercy of Excel's autofitting
.WorkSheets(1).UsedRange.VerticalAlignment = xlTop && set all to top
With .WorkSheets(1).Columns(5)
.ColumnWidth = 80 && 80 chars width
.WrapText = .T.
* .HorizontalAlignment = xlJustify && doesn't work good always
Endwith
* Finally some cosmetic stuff
For ix=1 To 3
With .WorkSheets(m.ix)
.Columns.AutoFit
.Rows.AutoFit
Endwith
Endfor
.WorkSheets(1).Activate
Endwith
Endwith
* Author: Cetin Basoz
* This is based on earlier VFP2Excel function codes
* that has been published on the internet, at various sites
* since 2001. Not to be messed with others' code who named the same but has
* nothing to do with the approaches taken here (unless copy & pasted and claimed
* to be their own work, < s > that happens).
Procedure VFP2Excel(tcCursorName, toRange, tcHeaders, tnPrefferredWidthForMemo)
* tcCursorName
* toRange
* tcHeaders: Optional. Defaults to field headers
* tnPrefferredWidthForMemo: Optional. Default 80
* Function VFP2Excel
tcCursorName = Evl(m.tcCursorName,Alias())
tnPrefferredWidthForMemo = Evl(m.tnPrefferredWidthForMemo,80)
Local loConn As AdoDB.Connection, loRS As AdoDB.Recordset,;
lcTemp,lcTempDb, oExcel,ix, lcFieldName, lcHeaders
lnSelect = Select()
lcTemp = Forcepath(Sys(2015)+'.dbf',Sys(2023))
lcTempDb = Forcepath(Sys(2015)+'.dbc',Sys(2023))
Create Database (m.lcTempDb)
Select * From (m.tcCursorName) Into Table (m.lcTemp) Database (m.lcTempDb)
Local Array aMemo[1]
Local nMemoCount
nMemoCount = 0
lcHeaders = ''
For ix = 1 To Fcount()
lcFieldName = Field(m.ix)
If Type(Field(m.ix))='M'
nMemoCount = m.nMemoCount + 1
Dimension aMemo[m.nMemoCount]
aMemo[m.nMemoCount] = m.ix
Replace All &lcFieldName With Chrtran(&lcFieldName,Chr(13)+Chr(10),Chr(10))
Endif
lcHeaders = m.lcHeaders + Iif(Empty(m.lcHeaders),'',',')+Proper(m.lcFieldName)
Endfor
tcHeaders = Evl(m.tcHeaders,m.lcHeaders)
Use In (Juststem(m.lcTemp))
Close Databases
Set Database To
loStream = Createobject('AdoDb.Stream')
loConn = Createobject('ADODB.Connection')
loRS = Createobject("ADODB.Recordset")
loConn.ConnectionString = "Provider=VFPOLEDB;Data Source="+m.lcTempDb
loConn.Open()
loRS = loConn.Execute("select * from "+m.lcTemp)
loRS.Save( loStream )
loRS.Close
loConn.Close
Erase (m.lcTemp)
* Use first row for headers
Local Array aHeader[1]
loRS.Open( loStream )
toRange.Offset(1,0).CopyFromRecordSet( loRS ) && Copy data starting from headerrow + 1
Set Safety Off
Delete Database (m.lcTempDb) Deletetables
Select (m.lnSelect)
For ix=1 To Iif( !Empty(m.tcHeaders), ;
ALINES(aHeader, m.tcHeaders,1,','), ;
loRS.Fields.Count )
toRange.Offset(0,m.ix-1).Value = ;
Iif( !Empty(m.tcHeaders), ;
aHeader[m.ix], ;
Proper(loRS.Fields(m.ix-1).Name) )
toRange.Offset(0,m.ix-1).Font.Bold = .T.
Endfor
#Define xlJustify -4130
#Define xlTop -4160
* This part is cosmetic
toRange.WorkSheet.Activate
With toRange.WorkSheet.UsedRange
.VerticalAlignment = xlTop && set all to top
For ix=1 To m.nMemoCount
With .Columns(aMemo[m.ix])
.ColumnWidth = m.tnPrefferredWidthForMemo && 80 chars width
.WrapText = .T.
Endwith
Endfor
.Columns.AutoFit
.Rows.AutoFit
Endwith
Endproc
* Return A, AA, BC etc noation for nth column
Function _GetChar
Lparameters tnColumn && Convert tnvalue to Excel alpha notation
If m.tnColumn = 0
Return ""
Endif
If m.tnColumn <= 26
Return Chr(Asc("A")-1+m.tnColumn)
Else
Return _GetChar(Int(Iif(m.tnColumn % 26 = 0,m.tnColumn - 1, m.tnColumn) / 26)) + ;
_GetChar((m.tnColumn-1)%26+1)
Endif
Endfunc
This is what I was looking for :-) I was trying with my knowledge of Excel Automation programming in Visual FoxPro but always got errors. My task was to create "n" Sheets from one big cursors which I want to parse regarding customer selection of attribute name from cursor to get also "n" Sheets. This sample is for 3 cursors and 3 Sheets and it is generic. But I need this for "n" cursors and one attribute which customer select to distinct and get "n" Sheets in one Excel file. So now I have dynamic procedure. I customized this code and solve my problem which I am trying to end for about 4 days. So again thank you for this code and off course I will not modify VFP2Excel procedure and wrote somewhere else my name. Thanks for help !
There is no native VFP function to do this, BUT, there is an awesome open source project which has a class that will make this very easy:
VFPx Workbook Xlsx - See it here on Github: XLSX Workbook for FoxPro
It has 3 magical functions that will do exactly what you asked for:
CreateWorkbook()
AddSheet()
SaveTableToWorkbook()
(Repeat commands 2 and 3 above for each DBF/Sheet you want to create)
It is well documented with a 54-page PDF and code sample that explains everything you'll need to know.
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
I'm very new (1 week) to visual basic and basically I'm trying to automate some repetitive work, now to the point , within a number of files produced with varying data I need to format the selected range as a table (medium 9) but i'm in a block at the moment and need some help and would really appreciate it, here is what i have so far>>>>
Option Explicit
Dim strDate, strRepDate, strPath, strPathRaw , strDate2
dim dteTemp, dteDay, dteMth, dteYear, newDate, myDate
myDate = Date()
dteTemp = DateAdd("D", -1, myDate)
dteDay = DatePart("D", dteTemp)
dteMth = DatePart("M", dteTemp)
dteYear = DatePart("YYYY", dteTemp)
If (Len(dteDay) = 1) Then dteDay = "0" & dteDay
If (Len(dteMth) = 1) Then dteMth = "0" & dteMth
strDate = dteYear&"-"&dteMth&"-"&dteDay
strDate2 = dteYear&""&dteMth&""&dteDay
Dim objXLApp, objXLWb, objXLWs
Set objXLApp = CreateObject("Excel.Application")
Set objXLWb = objXLApp.Workbooks.Open("C:\Users\CuRrY\Desktop\"&strDate2&"\Agent Daily Disposition "&strDate2&".xls")
objXLApp.Application.Visible = True
'start excell
Set objXLWs = objXLWb.Sheets(1)
'objXLWs.Cells(Row, Column ).Value
With objXLWs
objXLWs.Cells(3, 1).Value = "Agent Name"
'objXLWs.Range("A3").Select
objXLWs.Range("A3").CurrentRegion.Select
'End With
as you can see i reached as far as CurrentRegion.Select but how to format selected cells into (medium 9) i've tried so much and failed
Thanks for any help
You can configure the CurrentRegion(which represents a Range object) through the SpecialCells Submethod. Although your conditions are specific to your xls sheet, you will still have to follow the formatting available through the specialcells() method properties. Also, by utilizing the currentregion property, the page assumes you have a xls header. So it is important to verify your table structure before trying to incorporate this property.
For instance:
Sub FillIn()
Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 _
= "=R[-1]C"
Range("A1").CurrentRegion.Value = Range("A1").CurrentRegion.Value
End Sub
View the available properties that can be applied to CurrentRegion -> Here
And the MSDN Article -> Here
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.