It has been asked to me to make a sort of "exporting" feature on a site in ASP Classic.
I thought it could be really simple to make, but I got some problems. I get the right numbers of row in the file, but I get always the same recordset row, something like the recordset isn't updating the values during the foreach loop.
Here my code:
dim fs,f
set fs = Server.CreateObject("Scripting.FileSystemObject")
set f = fs.OpenTextFile(Server.MapPath("thebackupfile.csv"), 8, true)
set RS = conn.execute("SELECT * FROM sometable")
For each fField in RS.Fields
row = row & " " & fField.Name & ";"
Next
row = left (row, len(row)-1)
f.WriteLine(row)
do while not RS.EOF
For each fField in RS.Fields
csv = csv &" "& RS(fField.Name) & ";"
Next
csv = left (csv, len(csv)-1)
f.WriteLine(csv)
RS.movenext
loop
f.Close
set f = Nothing
set fs = Nothing
I can't figure out why I get n times the first row with n equals of the number of rows in the recordset.
Any advice? Am I taking the wrong way to do that?
I do spot a bug, but those results seem strange to me, too. The bug I see is that you are not clearing your csv variable on each iteration. What I'd expect is you'd have n(log n) number of rows, because when writing each new row you would also repeat everything that went before.
Update: Reading this again, the only time you write a new line is at the record boundaries as part of the f.WriteLine() call, so what I expect is that you get the right number of rows, but each row will be longer and longer, with new stuff added to the end of the row. Scroll the file to the right, and I bet you'll see the items in each row.
This means my code below should fix up your entire issue.
To fix the bug with clearing your csv variable, rather than add code to reset it I would change things to avoid the buffer string variable entirely, and write everything directly to your stream. I also added code to flush the stream every so often. These changes are important in a web context. If you don't flush your buffer, your browser might not see any response from your web server for a long time, and that could result in a timeout error. Given that this is tagged asp-classic, I wonder that you write to a file at all, rather than the response stream.
dim fs,f,d
set fs = Server.CreateObject("Scripting.FileSystemObject")
set f = fs.OpenTextFile(Server.MapPath("thebackupfile.csv"), 8, true)
d = ""
set RS = conn.execute("SELECT * FROM sometable")
For each fField in RS.Fields
f.Write(d)
f.Write(fField.Name)
f.Write(" ")
d= ";"
Next
f.WriteLine("")
Dim i
i = 0
do while not RS.EOF
d = ""
For Each fField in RS.Fields
f.Write(d)
f.Write(" ")
f.Write(RS(fField.Name))
d = ";"
Next
f.WriteLine("")
RS.movenext
i = i + 1
If i Mod 50 = 0 Then
f.Flush
End If
Loop
f.Close
set f = Nothing
set fs = Nothing
You should first load the values of a record into an array, then join that array into a delimiter-separated line, then write that line to the output file:
set RS = conn.Execute("SELECT * FROM sometable")
fields = Array()
Redim fields(RS.Fields.Count-1)
For i = 0 To RS.Fields.Count-1
fields(i) = RS.Fields(i).Name
Next
f.WriteLine """" & Join(fields, """;""") & """"
Do Until RS.EOF
For i = 0 To RS.Fields.Count-1
fields(i) = RS.Fields(i).Value
Next
f.WriteLine """" & Join(fields, """;""") & """"
RS.MoveNext
Loop
However, even better than that would be having MySQL directly generate the output file:
SELECT *
FROM sometable
INTO OUTFILE 'C:\\path\\to\\thebackupfile.csv'
FIELDS TERMINATED BY ';'
ENCLOSED BY '"'
LINES TERMINATED BY '\n'
Related
Trying to auto generate a sales id. But I don't know why I am getting this error.
Set qs = New ADODB.Recordset
qs.Open "select * from DailyRecords ", db, 3, 2
With qs
If .RecordCount = 0 Then
txtsalesID.Text = "S-0001"
Else
qs.MoveLast
txtsalesID.Text = "S-" & Format(Right(qs!SalesID, 4) + 1, "0000") // this line is producing the error
End If
I have even checked the database field name. It's the same as SalesID. I tried a lot and seeking for help
I think the problem is that you use RecordCount to check if the recordset is empty. The RecordCount leaves the cursor at the end of the recordset so you you will not be able to read data from the record, even if there are records. You should use EOF instead:
If .EOF Then
txtsalesID.Text = "S-0001"
Else
qs.MoveLast
txtsalesID.Text = "S-" & Format(Right(qs!SalesID, 4) + 1, "0000")
End If
I am updating an Access 2013 table through VBA. My task requires certain records to be added to the table during a loop and subsequently records to be read from the (updated) table. I am finding that my code works as expected provided I run through the code line by line in debug mode. However, if I run the code using F5, my results will be unpredictable. Sometimes the code works as expected and other times the loop finishes early. It looks as though the newly added records are not found by a select query, even though they have been added to the table. Referring to the code below, the INSERT INTO statement at the bottom is executed, but the subsequent opening of the adrsb recordset sometimes does not find the updated records, causing the loop to terminate early. I've been stumped on this for days now despite my best efforts in debugging. Any help will be very gratefully received. :)
Do
i = i + 1
'Debug.Assert i <> 4
If adrsb.State = 1 Then
adrsb.Close
Set adrsb = Nothing
Set adrsb = New ADODB.Recordset
adrsb.ActiveConnection = CurrentProject.Connection
adrsb.CursorType = adOpenStatic
End If
'adrsb.CursorType = adOpenDynamic
adrsb.Open "SELECT tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"FROM tblInScopeRestructures " & _
"GROUP BY tblInScopeRestructures.Code1, tblInScopeRestructures.Gen " & _
"HAVING (((tblInScopeRestructures.Gen)=" & i & "))" & _
"ORDER BY tblInScopeRestructures.Code1;"
adrsb.Requery
Dim adrsc As ADODB.Recordset
Set adrsc = New ADODB.Recordset
adrsc.ActiveConnection = CurrentProject.Connection
adrsc.CursorType = adOpenStatic
If Not adrsb.EOF Then
adrsb.MoveLast
adrsb.MoveFirst
End If
If adrsb.RecordCount <> 0 Then
adrsb.MoveFirst
'strPrevCode1 = adrsb.Fields("Code1")
Do While Not adrsb.EOF
strPrevCode1 = adrsb.Fields("Code1")
If adrsc.State = 1 Then
adrsc.Close
End If
adrsc.CursorType = adOpenStatic
adrsc.Open "SELECT tblRestructure.Code1, tblRestructure.Code2, tblRestructure.RecDate " & _
"FROM tblRestructure " & _
"WHERE (((tblRestructure.Code2)='" & strPrevCode1 & "'));"
If adrsc.RecordCount <> 0 Then
adrsc.MoveFirst
Do While Not adrsc.EOF
adConn.Execute ("INSERT INTO tblInScopeRestructures(Code1,Code2,RecDate,Gen) VALUES ('" & adrsc.Fields("Code1") & "','" & adrsc.Fields("Code2") & _
"',#" & Format(adrsc.Fields("RecDate"), "mm/dd/yyyy") & "#," & i + 1 & ")")
Debug.Print adrsc.Fields("Code1") & adrsc.Fields("Code2")
Debug.Print i + 1
For j = 1 To 100000
Next j
adrsc.MoveNext
Loop
End If
adrsb.MoveNext
If adrsc.State = 1 Then
adrsc.Close
End If
Loop
End If
Debug.Assert adrsb.RecordCount <> 0
Loop While adrsb.RecordCount <> 0
I reckon the problem is probably here
adrsb.CursorType = adOpenStatic
change it to
adrsb.CursorType = adOpenDynamic
And Instead of this bit of code:
For j = 1 To 100000
Next j
You could try something slightly less thrashy such as:
DoEvents
And maybe after the DoEvents command, you could try adding a Requery command on your ADODB recordset.
Except you will probably lose your desired cursor position, so before doing the Refresh, you can record the ID of your primary key in a variable and then find that cursor location in the recordset
intID = adrsb.Fields("MyKey")
adrsb.Requery
rs.Find "MyKey = " & intID
Ok, I've got a solution of sorts. I inserted the following code to cause a pause immediately after the second EXECUTE INTO operation:
TWait = Time
TWait = DateAdd("s", 5, TWait)
Do Until TNow >= TWait
TNow = Time
Loop
This slows the code down very significantly, but it works. I experimented with shorter pauses but tended to get the same problems with the loop sometime exiting early. While the immediate problem is solved, I'm left a bit stunned that this is necessary and am worried about when such an issue will next raise its head.
So I have a table in SQLSERVEr from where I select data and try to write it to a .CSV file. Everything looks good, but for some reason the first column of data seems to be in some weird kind of format because, I am unable to align text to text or right. When I do click on one of the alignment button, the text in the column barely moves. All other data seems to be fine, I feel like the first column is the only problematic one.
Here's what my code looks like
Dim sSQL As String
Dim cRS As ADODB.Recordset
Dim T As Long
Dim b As Long
Dim strLine As Variant
sSQL = ""
sSQL = "X, Y, Z from tblA”
Set cRS = New Recordset
cRS.Open sSQL, g_cn, adOpenStatic
If cRS.RecordCount > 0 Then
cRS.MoveLast
T = cRS.RecordCount
cRS.MoveFirst
Else
T = 0
End If
Open filenameCSV For Output As #1
For b = 1 To T
strLine = ""
strLine = cRS!X & ","
strLine = strLine & cRS!Y & ","
strLine = strLine & cRS!Z & ","
Print #1, , strLine
cRS.MoveNext
Next
Close #1
cRS.Close
Set cRS = Nothing
So like I said, this code works. It writes data properly to .CSV except with the formatting in the first column, mainly column X
Instead of Print #1, I tried Put #1 but that gives me an error saying Bad File Code
This .csv file is being loaded into some finance software, and i believe the formatting in column X is causing the issues, basically the software does not recognize a value in that column.
FYI..I simpliefied the query.
Anyone have any ideas?
EDIT:
I tried running it from a new file
And I added VBCRLF at the end of the loop before I move to next recordset
strLine = strLine & vbCrLf
Put #1, , strLine
The .csv file gets created but I get a weird symbol in each cell in teh first column
EDIT2 : Opened with Notepad++
My code reads in lines of a .csv file (comma separated file) and assigns each value to a local variable. After I have done some logic and stored the values in a table, I read in the next line of the .csv file and repeat the process. My question is what is the objRecordset.MoveNext doing compared to the loop. Here is my code, some of it has been removed to focus on the loop and objrecordset.MoveNext.
objconnection.Open 'connection string'
objRecordset.Open "SELECT * FROM [" & ThisFileName & "]", objconnection, adOpenStatic, adLockOptimistic, adCmdText 'select all text lines from the file
Do While Not objRecordset.EOF 'read lines until end of file
'Clear out all the local objects so prior values aren't left there
SampleName = ""
DateTimeAcquired = ""
Analyte = ""
Concentration = ""
Units = ""
'reads in each value according to column name and save to variable'
SampleName = objRecordset.Fields("Sample Name").Value
DateTimeAcquired = objRecordset.Fields("Date and Time Acquired").Value
Analyte = objRecordset.Fields("Element Full Name").Value
Concentration = objRecordset.Fields("Concentration").Value
Units = objRecordset.Fields("Units").Value
'Logic done on variables'
objRecordset.MoveNext
Loop
I am using Access 2010 VBA
objRecordset.MoveNext serves two purposes
As an Exit condition
Move to Next record
If you don't have objRecordset.MoveNext then the loop will continue infinitely since it doesn't reach objRecordset.EOF and rather stays on same record
I am trying to make a form which searches for the value inside all of the tables in the database (there are more than 1 table). The result will be displayed as the name of the table which this appears in. If someone can help me that will be nice.
In short, I have a form with a textbox and button. I enter the search string (for example 183939) and click on the button. It searches the value (183939) inside all the fields in the tables in the database, and if the value is found, then it displays the name of the table that it appears in. Thanks for the help.
I think this is a bad idea because it could take a very long time, and provide confusing results due to also searching system tables... but the following function will return an array of all table names containing the search term or nothing if it wasn't found. Calling example is such: theTables = containingTable("hello") where theTables is a variant. A limitation is that this will fail for multi-valued fields.
Function containingTables(term As String)
Dim db As Database
Dim tds As TableDefs
Dim td As TableDef
Set db = CurrentDb
Set tds = db.TableDefs
For Each td In tds
For Each f In td.Fields
On Error Resume Next
If DCount("[" & f.Name & "]", "[" & td.Name & "]", "[" & f.Name & "] LIKE '*" & term & "*'") Then
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
Err.Clear
On Error GoTo 0
Else
containingTables = containingTables & td.Name & ","
Exit For
End If
End If
Next
Next
Set tds = Nothing
Set db = Nothing
'Alternate Version
if Len(containgingTables) then containingTables = Left(containingTables, Len(containingTables) - 1)
'Original Version
'if Len(containgingTables) then containingTables = Split(Left(containingTables, Len(containingTables) - 1), ",")
End Function
To display the results with the alternate version, just use: Msgbox(containingTables(searchTerm)) where searchTerm is whatever you are searching.
Me as well i don't know why you would want to do something like that...
I think the solution posted by Daniel Cook is correct, i just took a slightly different approach. Do you need to match the exact value like I do? Anyway, here's my code:
Function searchTables(term as String)
Dim T As TableDef
Dim Rs As Recordset
Dim Result() As String
Dim Counter
Counter = 0
For Each T In CurrentDb.TableDefs
If (Left(T.Name, 4) <> "USys") And (T.Attributes = 0) Then
Set Rs = T.OpenRecordset
While Not Rs.EOF
For Each Field In Rs.Fields
If Rs(Field.Name) = term Then
Counter = Counter + 1
ReDim Preserve Result(Counter)
Result(Counter) = T.Name & "," & Field.Name
End If
Next
Rs.MoveNext
Wend
Rs.Close
End If
Next
If Counter = 0 Then
searchTables = Null
Else
searchTables = Result
End If
End Function
You should filter out duplicated values, in case the function matches multiple times the same filed in the same table.