I have a table in an excel file called " Employee_States_File".This table contains two columns Name and States. Both columns are filled with data. The province table contains abbreviation of the States such as " NE, WA" and so. I have another excel file called " States_File" which contains a table that has two columns: Abbreviation and FullStateName. This table is considered to be a lookup table to look for the full state names based on the abbreviation. Now, I want to write a code in VB6 so that when the user click a button, All the abbreviation names in the table of the excel file " Employee_States" are changes into the full state names based on the lookup table of the excel sheet " States_File".
does it make sense?
Please help,
If you are allowed to convert them to csv files (comma delimited text files) you can use the Jet Database engine and do normal SQL joins.
I use this to setup the connection.
Public Function OpenTextConnection(ByVal FileName As String) As Connection
Dim FSO As FileSystemObject
Dim DBFolder As String
Dim TS As TextStream
Set FSO = New FileSystemObject
DBFolder = FSO.GetParentFolderName(FileName)
If FSO.FileExists(FSO.BuildPath(DBFolder, "Schema.ini")) Then
FSO.DeleteFile (FSO.BuildPath(DBFolder, "Schema.ini"))
End If
Set TS = FSO.CreateTextFile(FSO.BuildPath(DBFolder, "Schema.ini"))
TS.WriteLine "[" & FSO.GetFileName(FileName) & "]"
TS.WriteLine "Format=CSVDelimited"
TS.WriteLine "ColNameHeader = True"
TS.WriteLine "MaxScanRows = 0"
TS.Close
Set OpenTextConnection = New Connection
If FSO.FolderExists(DBFolder) Then
OpenTextConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFolder & ";Extended Properties=""text;HDR=Yes;FMT=Delimited;"";"
Else
MsgBox DBFolder & " Does not exists.", vbExclamation
End If
End Function
Each file is a table in the connection and you can do SQL joins. Note the example is just a simply open up a table. You can use any valid SQL Syntax.
Dim DB1 As Connection
Dim TB As Recordset
Dim FSO As FileSystemObject
Dim tImport As New DBImportList
Set FSO = New FileSystemObject
Set tImport = New DBImportList
If FSO.FileExists(FileName) Then
Set DB1 = OpenTextConnection(FileName)
Set TB = New Recordset
TB.Open "SELECT * FROM [" & FSO.GetFile(FileName).Name & "]", DB1, adOpenKeyset, adLockOptimistic, adCmdText
End If
Related
I'm using a piece of software called Chronoscan which uses VBScript.
I am attempting to create and append to a file, which in part is successful. However, I am trying to place an argument based on a child table as to whether or not to export the data.
Firstly I am counting the number of records contained in a table named 'batch' (unique id) and looping this against the record number I am assigning variables, within this loop I have another loop which is doing the same for a child table named 'Grid' again assigning variables. I am then writing these variables to the file. Therefore I am writing a value for the number of records held in the child table for each record held in its parent.
What I actually want to do is to argue against the child table and only write records if it meets my argument.
The child table has a field called SkuType which has 3 possible values M, A or NULL.
My argument needs to be if the child table has a value of M write the record else don't, if the child table does not have a value of M in any of its records relating to it parent then only write the first record from the child table and ignore the remainder.
Please see below example of my code, which works fine for exporting ALL records from the child table.
Dim fso
Dim FilePathName
Dim FilePath
Dim NumDocs
Dim numRows
Dim Station
Dim StationDate
Dim StationTime
Dim StationName
Dim Exp
GridPanel = 1 'first panel
Set Batch = ChronoApp.GetCurrentBatch
CurrentBatchname = Batch.Getname
NumDocs = Batch.GetDocCount
'Set output filename and path here
Station = ChronoApp.GetVariableValue("station_user")
StationDate = Left(ChronoApp.GetVariableValue("station_date_full"), 10)
StationName = ChronoApp.GetVariableValue("station_name")
Set fso = CreateObject("Scripting.FileSystemObject")
'Loop the batch here
For numDoc = 0 To NumDocs-1
FilePath = "C:\Users\" & Station & "\Google Drive\Driver Scans\ChronoPlans\" &_
Left(Batch.GetUserField(numDoc, "Movement Date"),2) &_
Mid(Batch.GetUserField(numDoc, "Movement Date"),4,2) &_
Right(Batch.GetUserField(numDoc, "Movement Date"),2) & "\"
FilePathName = FilePath & StationName & "_" & StationDate & ".CSV"
If Not fso.FolderExists(FilePath) Then FSO.CreateFolder (FilePath) 'create folder if it does not exist
Set inputFile = fso.OpenTextFile(FilePathName, 8, True)
'Get header level fields here
StationTime= Left(ChronoApp.GetVariableValue("station_date_full"), 16)
'Loop grid here
numRows = Batch.GetXgridRowCount (numDoc, GridPanel)
For row = 0 To numRows-1
'Get grid level fields here
SkuType = Batch.GetXgridFieldValue (numDoc, GridPanel, row, "SkuType")
'Get Serial
SKU = Batch.GetXgridFieldValue (numDoc, GridPanel, row, "SKU")
'Write to file here
inputFile.WriteLine(_
Chr(34) & SKU & Chr(34) & "," &_
Chr(34) & StationTime & Chr(34)& "," &_
Chr(34) & SkuType & Chr(34) )
Next 'loop Grid
inputFile.Close
Next 'Loop Batch
'Now cleanup
inputFile.Close
Set inputFile = Nothing
Set fso = Nothing
I am trying to do a small program on VB 6.0 to find the records in database and print it in text box based on combo box selection but i failed to find a code which allow me to do this.
Any help please.
Dim adoCon
Dim adoRs
Dim strSQL As String
Dim strDB As String
'Change YourDatabaseName to actual database you have
strDB = "c:\path\YourDatabaseName.accdb"
Set adoCon = CreateObject("ADODB.Connection")
adoCon.Open "Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source = " & strDB & ";" & _
"Persist Security Info = False;"
'Change Table1 to your table name in MS Access
'change the name of combobox and the fieldname in MS Access table
'
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' if combo is numeric
strSQL = "SELECT [fieldNameToReturn] FROM Table1 Where [fieldName] = " + [combo].Value + ";"
' if combo is text
'strSQL = "SELECT [fieldNameToReturn] FROM Table1 Where [fieldName] = '" + [combo].Value + "';"
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''
Set adoRs = CreateObject("ADODB.Recordset")
'Set the cursor type we are using so we can navigate through the recordset
adoRs.CursorType = 2
'Set the lock type so that the record is locked by ADO when it is updated
adoRs.LockType = 3
'Open the tblComments table using the SQL query held in the strSQL varaiable
'adoRs.Open strSQL, adoCon
If Not adoRS.Eof() Then
[yourTextBox] = adoRs(0)
End If
adoRs.Close
adoCon.Close
Set adoRs = Nothing
Set adoCon = Nothing
"BOF" below is not a typo. If the recordset is empty (the query returned no records) BOF will be true.
adoRs.Open strSQL, adoCon
If Not adoRS.BOF Then
'If not _BOF_ we have records so load the first record
adoRs.MoveFirst
'If first field is a string then use this
[yourTextBox] = adoRs.Fields(0).Value
'If first field is numeric then use this
[yourTextBox] = CStr(adoRs.Fields(0).Value)
Else
Msgbox "No records returned."
End If
If you were processing multiple records you would still do the MoveFirst and then loop until EOF was true, processing each record. The MoveNext will set EOF = True when there are no more records to process.
adoRs.Open strSQL, adoCon
If Not adoRS.BOF Then
'If not _BOF_ we have records so load the first record
adoRs.MoveFirst
Do While Not adoRS.EOF
'Process records here
'.
'.
'.
adoRS.MoveNext
Loop
Else
Msgbox "No records returned."
End If
I need to use VBA to query a big data table (2.000.000 rows and 130 columns) from Oracle database and save it into text file.
The code I am using is the following
Dim DBConnection As ADODB.connection
Dim RecordSet As ADODB.RecordSet
'prepare string for connection
Dim strConnection As String
strConnection = "DRIVER=Oracle in OraClient11g_Home32;SERVER=" & database & " ;UID=" & username & ";PWD=" & password & ";DBQ=" & database & ";"
Set DBConnection = New ADODB.connection
'open connection
With DBConnection
.CommandTimeout = False
.ConnectionString = strConnection
.CursorLocation = adUseClient
.Open
End With
Set RecordSet = New ADODB.RecordSet
RecordSet.Open strSQLQuery, DBConnection, adOpenForwardOnly, adLockReadOnly
Do While RecordSet.EOF = False
str = ""
For x = 0 To RecordSet.Fields.Count - 1
If IsNumeric(RecordSet.Fields(x).Value) Then
dx = RecordSet.Fields(x).Value
str = str & Format(dx, "0.############") & delimiter
Else
str = str & RecordSet.Fields(x).Value & delimiter
End If
Next x
Print #FH, str
RecordSet.MoveNext
Loop
The problem is that probably ADO tries to store in the recordset all the queried data, which will be several GB of data, thus using too much RAM.
I need to find a way to limit the number of rows that are stored in RAM at one time, so that I can download and save as many row as I want without having any issue with the RAM.
I researched but I cannot find anything about this.
Thank you.
May be you should try setting CursorLocation to adUseServer...
Okay so the script that I have written is almost fully functional but I would like to add two things to it. What it currently does is you type in a CallID number that is associated with other data on a database in SQL Server. When you type in the number into the msgbox it retrieves all the other columns that are associated with that particular number and outputs it to the command prompt and also outputs it to a text file on the hard drive. This is good, but the formatting is horrible. How would I go about improving the formatting of the file so it is more reading. Currently it is just a line with space seperating each piece of data. Also what I would like to be able to do is also have the name of each Column under each piece of data that is associated with that column. Any help would be appreciated. Here is my code with sensitive information omitted:
Dim strQuery
strQuery = InputBox("Enter CallID Please:")
Dim sServer
Dim sLogin
Dim sPwd
Dim sDb
Dim oCn
Dim oRs
Dim strFullQuery
Dim strfield
Const ForReading = 1
sServer = ""
sLogin = ""
sPwd = ""
sDb = ""
Set oCn = CreateObject( "ADODB.Connection" ) ' set oCn to create an object called ADODB.Connection
Set oRs = CreateObject( "ADODB.Recordset" ) ' set oRs to create an object called ADODB.Recordset
oCn.ConnectionString = "PROVIDER=SQLOLEDB" & _
";SERVER=" & sServer & _
";UID=" & sLogin & _
";PWD=" & sPwd & _
";DATABASE=" & sDb & " "
oCn.ConnectionTimeout=600
oCn.open 'Open the connection to the server
strFullQuery = "select * from dbo.CallLog where CallID=" + strQuery 'this is the SQL statement that runs a query on the DB
oRs.Open strFullQuery,oCn 'This opens the record set and has two parameters, strFullQuery and oCn
If oRs.EOF Then 'If open record set is at the end of file then...
wscript.echo "There are no records to retrieve; Check that you have the correct record number." 'echo that there is no records to retrieve.
End if
'if there are records then loop through the fields
oRs.MoveFirst 'move to the first object in the record set and set it as the current record
Do Until oRs.EOF ' Do while not open record set is not end of file
Set objFileSystem = WScript.CreateObject("Scripting.FileSystemObject") 'Set objFileSystem to create object Scripting.FileSystemObject
Set objOutPutFile = objFileSystem.CreateTextFile("c:\test.txt", True) 'Set objOutPutFile to create object objFileSystem.CreateTextFile
objOutPutFile.WriteLine strColumnNames
strfield = oRs.GetString
if strfield <> "" then 'If strfield doesn't equal "" then
WScript.echo strfield
objOutPutFile.WriteLine strfield &"|"
'objFileSystem.close
objOutPutFile.close
end If
'oRs.MoveNext 'Move to the next object in the record set
Loop
oCn.Close
You can add space to make fixed-widths. Let's say you know that every field will be 20 characters or less:
objOutPutFile.WriteLine strfield & String(20-Len(strfield)," ") & "|"
here is my code
Dim Cn1 As ADODB.Connection
Dim iSQLStr As String
Dim field_num As Integer
Set Cn1 = New ADODB.Connection
Cn1.ConnectionString = _
"Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"DefaultDir=" & "C:\path\"
Cn1.Open
iSQLStr = "Select * FROM " & "file.txt" ' & " ORDER BY " & txtField.Text
field_num = CInt(1) - 1
Set Rs1 = Cn1.Execute(iSQLStr)
lstResults.Clear
While Not Rs1.EOF
DoEvents
Rs1.Fields(field_num).Value = "qaz"
If IsNull(Rs1.Fields(field_num).Value) Then
lstResults.AddItem "<null>"
Else
lstResults.AddItem Rs1.Fields(field_num).Value
End If
Rs1.MoveNext
Wend
The error i get is in this line
Rs1.Fields(field_num).Value = "qaz"
it says "The current recordset does not support updating", what is wrong in the code?
I'm not sure if this is valid for text files but with SQL Server you need to change the LockTypeEnum Value setting to allow editing see this link, the default is adLockReadOnly
Edit
According to this link it is not possible to edit a text file via ADO.