How do I read data from an xBase/Clipper file in VB6? - vb6

DBF file is in C:\dbase\clip53\PRG\stkmenu\WPACK3\
DBF file is called WPACKS.CFG (deliberately not .DBF)
The VB6 code in an ActiveX EXE for opening the database and recordset:
Function OpenDatabase(sFile As Variant, Optional sProvider As Variant = "Provider=Microsoft.Jet.OLEDB.4.0") As Variant ' ADODB.Connection
Dim nErr As Long
Dim sErr As String
Dim oConnection As Object 'ADODB.Connection
Set oConnection = CreateObject("ADODB.Connection")
On Error Resume Next
oConnection.open sProvider & ";Data Source=" & sFile
nErr = Err.Number
sErr = Err.Description
On Error GoTo 0
If nErr <> 0 Then
Err.Raise OPENDATABASE_E_NOTFOUND, , sErr
End If
Set OpenDatabase = oConnection
End Function
Function OpenRecordSet(ByRef oDb As Variant, sQuery As Variant, Optional bCmdText As Boolean = False) As Variant ''ADODB.Connection ADODB.Recordset
Const adOpenForwardOnly As Long = 0
Const adOpenStatic As Long = 3
Const adOpenDynamic As Long = 2
Const adOpenKeyset As Long = 1
Const adLockOptimistic As Long = 3
Const adCmdText As Long = 1
Dim oRecordSet As Object 'ADODB.Recordset
Set oRecordSet = CreateObject("ADODB.RecordSet")
If bCmdText Then
oRecordSet.open sQuery, , , adCmdText
Else
oRecordSet.open sQuery, oDb, adOpenKeyset, adLockOptimistic
End If
Set OpenRecordSet = oRecordSet
End Function
The script accessing these methods looks a little like VBScript. It is VBScript, but executed by the aforementioned ActiveX EXE which uses MSScript control and has a whole pile of objects which it can make available to the script engine. A kind of VBScript-on-steroids approach.
uses database
uses system
dim db
dim rs
set db = database.opendatabase("C:\dbase\clip53\PRG\stkmenu\WPACK3\","Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=dBase III;User ID=Admin;Password=")
set rs = database.openrecordset(db, "SELECT * FROM WPACKS.CFG",true)
system.consolewriteline rs.recordcount
My problem is that I keep getting The connection cannot be used to perform this operation. It is either closed or invalid in this context. when it hits the oRecordSet.open sQuery, , , adCmdText (which I got from a Microsoft site.)
'Tis a tad irritating.

The connection string I use when I need to connect a DBF file is usually something like:
"Driver={Microsoft dBase Driver (*.dbf)};dbq=<filePath>"
It works fine for me.

try using the latest and greatest FoxPro driver.

Related

Use ADODB Recordset to INSERT Oracle DB

I am converting some Excel-VBA code that uploaded a DAO recordset to an Access database. My new code uses ADODB objects and needs to push the data to Oracle 12c.
I reviewed some articles, and found a handy equivalency chart here: From-DAO-to-ADO. Using this information I created the following code.
This first bit just loads up the source recordset. No problems here, but published if it's relevant:
Dim CN As New ADODB.Connection, RS As New ADODB.Recordset
Dim SRC_CN As New ADODB.Connection, SRC_RS As New ADODB.Recordset, SRC_CMD As New ADODB.Command
strSQL = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Src_WB_nm & _
";Extended Properties='Excel 12.0 Xml;HDR=NO';"
SRC_CN.Open strSQL
Set SRC_CMD.ActiveConnection = SRC_CN
SRC_CMD.CommandType = adCmdText
SRC_RS.Close
Set SRC_RS = Nothing
strSQL = "SELECT * FROM [" & TableNm & "]"
SRC_CMD.CommandText = strSQL
With SRC_RS
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open SRC_CMD
End With
In this segment, I open the destination connection and attempt to open the destination recordset. Thismethodology (AddNew, RS...value = RS.value, RS.Update...) worked when I was in DAO. I expect it may need to be modified somewhat, but its the RS.Open command that I can't get past now.
CN.Open CSTRG
strSQL = "DELETE FROM DFSTOOL.C_QUERYLIST"
Set RS = CN.Execute(strSQL)
Set RS = Nothing
RS.Open "DFSTOOL.C_QUERYLIST", CN, adCmdTable
Do Until SRC_RS.EOF
RS.AddNew
RS.Fields(0).Value = SRC_RS.Fields(0).Value
RS.Update
SRC_RS.MoveNext
Loop
RS.Close
SRC_RS.Close
Set RS = Nothing
Set SRC_RS = Nothing
The error thrown is:
I appreciate any help you can provide!
So happily this was a simple syntax issue. Perhaps I should delete the post, but I'll leave it for now in case it helps anyone else. The equivalency table I referenced noted that the "adCmdTable" is an option in ADO, whereas the equivalent "dbOpenTable" was a type in DAO. Thus, I was required to skip a few fields so that it was in the right location. Other fine-tuning followed and the final iteration works as expected:
RS.Open "DFSTOOL.C_QUERYLIST", CN, adOpenForwardOnly, adLockOptimistic, adCmdTable
Do Until SRC_RS.EOF
RS.AddNew
RS.Fields(1).Value = SRC_RS.Fields(0).Value
RS.Update
SRC_RS.MoveNext
Loop
Thanks for your patience community!

How to connect a database to crystal report at run time?

I am developing winform application in vb6. I am using crystal report 4.6. I have created a crystal report which shows all data from a table (MS Access). And I unchecked save data with report and i saved the report. I just want to invoke it in application. So I included the component CrystalReportControl in my application. Now i want to set the records to be displayed in the report. The records are selected according to the user input to the text box.
Records are retrived from the database is done in following code.
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub Command1_Click()
Set conn = New ADODB.Connection
conn.Open "provider=Microsoft.jet.oledb.4.0;Data Source=" & App.Path &"\faculty.mdb"
Set rs = New ADODB.Recordset
rs.Open "select * from facultydetails where eid=1234", conn, adOpenDynamic, adLockPessimistic
CrystalReport1.ReportFileName = App.Path & "\faculty.rpt"
Set CrystalReport1.DataSource = rs
CrystalReport1.Action = 1
End Sub
Gives an error for the line: Set CrystalReport1.DataSource = rs :
as Property is write-only.
Tell me how the records of the report can be dynamic? Plz help me...
Instead of
Set CrystalReport1.DataSource = rs
do
CrystalReport1.DataSource = rs
EDIT:
Take a look at the following example and see if that will help you:
'CrystalReport1 is the name of the dsr file
Dim Report As New CrystalReport1
Dim cdoRowset As CrystalDataObject.CrystalComObject
Dim varArray() As Variant
'Open ADO Connection
Set m_cnAdo = New ADODB.Connection
m_cnAdo.ConnectionString = "DRIVER={SQL Server};UID=[UserID];PWD=[Password]" _
& ";SERVER=[Server];DATABASE=[Database]"
m_cnAdo.Open
Dim rsAdo As ADODB.Recordset
Dim cmdAdo As ADODB.Command
'Using Embedded Query
Set cmdAdo = New ADODB.Command
Set rsAdo = New ADODB.Recordset
cmdAdo.ActiveConnection = m_cnAdo
cmdAdo.CommandText = "SELECT * FROM Table WHERE Param = " & lngParam1
cmdAdo.CommandType = adCmdText
Set rsAdo = cmdAdo.Execute
Report.Database.SetDataSource rsAdo, 3, 1

VB6 : error when calling .Open on an adodb.Connection object (works with specific contexts)

I'm currently working with small-size old VB6 application.
Here is my problem : when the user clicks a button, the program is opening a connection to an Oracle Database. This works good when running from the IDE or running the .exe in Windows 95 or Windows 98 compatibility modes, otherwise it crashes.
It does work on another workstation but I don't know why (different configuration but I have no idea what that could be !)
Here is the code called when the button is pressed (it works on another workstation which has no compatibility setting set but might have some other configuration differences).
Most of the code is not related to the connection but I have let it untouched for the sake of completeness.
Private Sub Form_Load()
'
' Loads the list of printers (as defined in a table of the SQL DB)
'
On Error GoTo error_handler
' icon
Screen.MousePointer = vbHourglass
'Dim conn As New adodb.Connection
'Dim cmd As New adodb.Command
'Dim rcs As New adodb.Recordset
Dim conn As adodb.Connection
Dim cmd As adodb.Command
Dim rcs As adodb.Recordset
Set conn = New adodb.Connection
Set cmd = New adodb.Command
Set rcs = New adodb.Recordset
'Dim fs As New FileSystemObject
Dim fs As FileSystemObject
Set fs = New FileSystemObject
Dim fic As File
Dim texte As textStream
Dim req As String
Dim i As Integer
Dim chem As Variant
Dim buffer As String
Dim retstring As String
Dim rc As Long
If fs.FileExists(Appli_Rep & "Queries\System\printers_list.txt") Then
Set fic = fs.GetFile(Appli_Rep & "Queries\System\printers_list.txt")
Set texte = fic.OpenAsTextStream(ForReading)
End If
'
' Reads connection string
'
buffer = String(145, " ")
rc = GetPrivateProfileString("Requete", "DRIVER", "1", buffer, Len(buffer) - 1, Appli_Rep & "suivi__.ini")
DoEvents
retstring = Left(buffer, InStr(buffer, Chr(0)) - 1)
'
' Gets the PATH environment variable
' So that we know where to find tnsname.ora
'
i = 0
chem = Split(Environ("TNS_ADMIN"), ";")
Do
If Len(Dir(chem(i) & "\Tnsnames.ora")) <> 0 Then
ChDrive chem(i)
ChDir chem(i)
Exit Do
End If
i = i + 1
DoEvents
Loop Until i > UBound(chem)
' Opens a connection (no DSN)
'Set conn = New adodb.Connection
conn.ConnectionString = "uid=_uid;pwd=_pwd;DRIVER=" & retstring & ";server=__PROD;"
'conn.ConnectionTimeout = 30
conn.ConnectionTimeout = 3000 ' (no change)
conn.Open ' -2147467259 [Microsoft][ODBC driver for Oracle][Oracle]ORA-06413: Connexion non ouverte
' Connexion non ouverte = french for "connection is closed".
Set cmd.ActiveConnection = conn
cmd.CommandText = texte.ReadAll
DoEvents
Set texte = Nothing
Set fic = Nothing
Set fs = Nothing
Set rcs = cmd.Execute
DoEvents
rcs.MoveFirst
Do
Me.cbo_Imprimantes.AddItem (rcs.Fields("IMPRIMANTE").Value)
rcs.MoveNext
DoEvents
Loop Until rcs.EOF
' Close connections / free objects
Set rcs = Nothing
Set cmd = Nothing
If conn.State = 1 Then
conn.Close
End If
Set conn = Nothing
' icon back to normal
Screen.MousePointer = vbDefault
Exit Sub
error_handler:
' retour normal
Screen.MousePointer = vbDefault
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbCritical + vbOKOnly, "Erreur !!!"
MsgBox Err.Source
End If
On Error Resume Next
' Fermeture des objets
Set rcs = Nothing
Set cmd = Nothing
Set conn = Nothing
Set texte = Nothing
Set fic = Nothing
Set fs = Nothing
End Sub
It crashes on the "conn.Open" statement.
The connection string is identical in both cases (I have displayed it in a messagebox to be sure that 'retstring' is valid).
Thanks for your time.

How to read an Excel file(97-03) in Visual Basic 6.0

Can anybody tell me how to read an Excel file in visual basic 6.0 and import all the values into a listview or datagridview,want to use a simple and efficient technique to achieve this. can anyone help me to solve this
This should import data from an Excel file into a ListView:
Dim ExcelObj As Object
Dim ExcelBook As Object
Dim ExcelSheet As Object
Dim i As Integer
Set ExcelObj = CreateObject("Excel.Application")
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelObj.WorkBooks.Open App.Path & "\ExcelFile.xls"
Set ExcelBook = ExcelObj.WorkBooks(1)
Set ExcelSheet = ExcelBook.WorkSheets(1)
Dim l As ListItem
lvwList.ListItems.Clear
With ExcelSheet
i = 1
Do Until .cells(i, 1) & "" = ""
Set l = lvwList.ListItems.Add(, , .cells(i, 1))
l.SubItems(1) = .cells(i, 2)
l.SubItems(2) = .cells(i, 3)
l.SubItems(3) = .cells(i, 4)
i = i + 1
Loop
End With
ExcelObj.WorkBooks.Close
Set ExcelSheet = Nothing
Set ExcelBook = Nothing
Set ExcelObj = Nothing
I'd be a lot more likely to use a grid control of some sort rather than a ListView for this, but...
Since you're merely bringing in values without metadata (formatting) you can use one of Jet's Excel IISAMs to do this and it even works on machines where Excel is not installed!
Dim SheetName As String
Dim RS As ADODB.Recordset
Dim LI As ListItem
Dim I As Integer
'Look up 1st Worksheet (or just hardcode its Name).
'
'Notes:
' o Can use Excel 8.0 or Excel 5.0 to read most Excel 7.0/97
' Workbooks, but there is no IISAM specifically for Excel 7.0.
' o Use HDR=Yes if your Worksheet has a header row.
With CreateObject("ADOX.Catalog")
.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" _
& App.Path & "\sample.xls';" _
& "Extended Properties='Excel 5.0;HDR=No'"
SheetName = .Tables(0).Name
Set RS = New ADODB.Recordset
Set RS.ActiveConnection = .ActiveConnection
End With
'The "Table" name can be a range too, e.g. [Sheet1$A1C7]
With RS
.Open "[" & SheetName & "]", _
, _
adOpenForwardOnly, _
adLockReadOnly, _
adCmdTable
ListView.ListItems.Clear
ListView.View = lvwReport
For I = 0 To .Fields.Count - 1
ListView.ColumnHeaders.Add , , .Fields(I).Name
Next
Do Until .EOF
Set LI = ListView.ListItems.Add(, , CStr(.Fields(0).Value))
For I = 1 To .Fields.Count - 1
LI.SubItems(I) = CStr(.Fields(I).Value)
Next
.MoveNext
Loop
.Close
End With

Passing a recordset to a component method to be filled

I am having an odd issue where I am trying to pass three recordsets to a method to have them filled with data all under the same database connection. By reviewing the custom logging info when running the code below I can see that I am getting a Type Mismatch error when assigning the recordsets passed to the method to the local variables within the method.
So the following gets logged when the mthod is called:
7/15/2010 10:59:47 AM - Begin GetALLRecordSets
7/15/2010 10:59:47 AM - Begin GetALLRecordSets RS initialization
The odd bit is that this same code works on our beta server where the asp code is identical and the component dll is identical.
Any thoughts on what may be causing this issue?
Classic ASP code:
set rs1= createobject("ADODB.Recordset")
set rs2 =createobject("ADODB.Recordset")
set rs3 = createobject("ADODB.Recordset")
set myObj = Server.CreateObject("Component.className")
call myObj.GetAllRecordSets(rs1, rs2, rs3)
VB6 Component Code:
Public Sub GetALLRecordSets(ByRef rs1 As Variant, _
ByRef rs2 As Variant, _
ByRef rs3 As Variant)
On Error GoTo ErrorSpot
WriteToLog "Begin GetALLRecordSets", "", 0, ""
Dim lngErrNum As Long
Dim strErrDesc As String
Dim filterStr As String
Dim objConn As ADODB.Connection
Dim myrs1 As ADODB.Recordset
Dim myrs2 As ADODB.Recordset
Dim myrs3 As ADODB.Recordset
WriteToLog "Begin GetALLRecordSets RS initialization", "", 0, ""
Set myrs1 = rs1
Set myrs2 = rs2
Set myrs3 = rs3
WriteToLog "End GetALLRecordSets RS initialization", "", 0, ""
Set rs1 = myrs1.Clone
Set rs2 = myrs2.Clone
Set rs3 = myrs3.Clone
ExitSpot:
'Cleanup
Exit Sub
ErrorSpot:
'Save the error information
lngErrNum = Err.Number
strErrDesc = Err.Description
'Log the error
WriteToLog "GetALLRecordSets", strErrDesc, lngErrNum, strErrDesc
End Sub
Different version of MDAC on server? You may need to create a specific version of Recordset e.g.
Set rs1 = CreateObject("ADODB.Recordset.2.8")

Resources