BarNet
12-13-2010, 07:38 AM
HI I am trying to work a simple script that allows administrators to download selected fields in the database as CSV
The download seems to work however there is no data other than the title fields when you open the file.
Here is the code:
<% Option Explicit %>
<html>
<head>
<title>CSV Export</title>
</head>
<body>
<%
Dim DSNtemp,Conn,RS,action,arrTables,intTable,i,j,x,y, strFields,objFSO,objFile,strLine
'Insert your own DSN info here
DSNtemp="Provider=MSDASQL;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("MYDATABASE") & ";"
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.open DSNtemp,"admin",""
action = Request("action")
If action = "" Then
Set RS = Conn.OpenSchema(20) '--> adSchemaTables = 20
RS.Filter = "TABLE_TYPE = 'TABLE'"
Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getfields"" method=""POST"">" & VbCrLf
Response.Write "Select table(s):<BR>" & VbCrLf
Do While Not RS.EOF
Response.Write "<input type=""checkbox"" name=""tables"" value=""" & RS(2) & """>" & RS(2) & "<BR>" & VbCrLf
RS.MoveNext
Loop
Response.Write "<BR><input type=""submit"" value=""Next >>"">"
RS.Close
Set RS = Nothing
End If
If action = "getfields" Then
arrTables = Split(Replace(Request("tables")," ",""), ",")
Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getrecords"" method=""POST"">" & VbCrLf
Response.Write "<input type=""hidden"" name=""tables"" value=""" & Join(arrTables, ",") & """>" & VbCrLf
Response.Write "<input type=""hidden"" name=""next"" value=""0"">" & VbCrLf
Response.Write "Select field(s):<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Table: " & arrTables(i) & "<BR>" & VbCrLf
Set RS = Conn.Execute("SELECT * FROM " & arrTables(i))
For j = 0 to RS.Fields.Count-1
Response.Write "<input type=""checkbox"" name=""" & arrTables(i) & """ value=""" & RS.Fields(j).Name & """>" & RS.Fields(j).Name & "<BR>" & VbCrLf
Next
RS.Close
Response.Write "<input type=""checkbox"" name=""" & arrTables(i) & """ value=""*"">All Fields<BR>" & VbCrLf
Response.Write "<BR>"
Next
Response.Write "<input type=""submit"" value=""Next >>"">"
Set RS = Nothing
End If
If action = "getrecords" And Not Request("next") = "end" Then
arrTables = Split(Request("tables"), ",")
intTable = Request("next")
If Instr(Request(arrTables(intTable)),"*") = 0 Then strFields = Request(arrTables(intTable)) Else strFields = "*"
Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getrecords"" method=""POST"">" & VbCrLf
Response.Write "<input type=""hidden"" name=""tables"" value=""" & Request("tables") & """>" & VbCrLf
Response.Write "<input type=""hidden"" name=""table"" value=""" & arrTables(intTable) & """>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "<input type=""hidden"" name=""" & arrTables(i) & """ value=""" & Request(arrTables(i)) & """>" & VbCrLf
Next
If intTable >= 1 Then
For i = 0 to intTable-1
Response.Write "<input type=""hidden"" name=""" & arrTables(i) & "_rec"" value=""" & Replace(Request(arrTables(i) & "_rec")," ", "") & """>" & VbCrLf
Next
End If
If intTable+1 <= UBound(arrTables) Then
Response.Write "<input type=""hidden"" name=""next"" value=""" & intTable+1 & """>" & VbCrLf
Else
Response.Write "<input type=""hidden"" name=""next"" value=""end"">" & VbCrLf
End If
Response.Write "Table: " & arrTables(intTable) & "<BR>" & VbCrLf
Response.Write "Fields: " & strFields & "<BR><BR>" & VbCrLf
Response.Write "Select record(s):<BR>" & VbCrLf
j = 0
Set RS = Conn.Execute("SELECT " & Request(arrTables(intTable)) & " FROM " & arrTables(intTable))
Do While Not RS.EOF
If Instr(Request(arrTables(intTable)), ",") > 0 or Request(arrTables(intTable)) = "*" Then
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""" & j & """>" & Left(RS(0),10) & "," & Left(RS(1),10) & "<BR>" & VbCrLf
Else
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""" & j & """>" & Left(RS(0),10) & "<BR>" & VbCrLf
End If
RS.MoveNext
j = j + 1
Loop
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""ALL"">All records<BR>" & VbCrLf
Response.Write "<BR><input type=""submit"" value=""Next >>"">"
RS.Close
Set RS = Nothing
End If
If action = "getrecords" and Request("next") = "end" Then
Dim arrRecs,strOutput
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
arrTables = Split(Request("tables"), ",")
strOutput = Server.MapPath(".") & "\hp525hockey\" '<-- Edit this to change your output directory
For i = LBound(arrTables) to UBound(arrTables)
Set objFile = objFSO.CreateTextFile(strOutput & Trim(arrTables(i)) & ".csv")
Set RS = Conn.Execute("SELECT " & Request(arrTables(i)) & " FROM " & arrTables(i))
strLine = ""
If Instr(Request(arrTables(i)),"*") = 0 Then
objFile.WriteLine Replace(Request(arrTables(i)), " ", "")
Else
For j = 0 to RS.Fields.Count-1
strLine = strLine & RS.Fields(j).Name
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
End If
If Instr(Request(arrTables(i) & "_rec"), "ALL") <> 0 Then
Do While Not RS.EOF
strLine = ""
For j = 0 to RS.Fields.Count-1
strLine = RS(j)
If isNull(strLine) Then strLine = ""
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
RS.MoveNext
Loop
Else
arrRecs = Split(Replace(Request(arrTables(i) & "_rec")," ",""),",")
x = 0
y = 0
Do While Not RS.EOF
strLine = ""
If Not x > UBound(arrRecs) Then
If y = Int(arrRecs(x)) Then
For j = 0 to RS.Fields.Count-1
If Not IsNull(RS(j)) Then strLine = strLine & Chr(34) & Replace(RS(j), Chr(34), Chr(34) & Chr(34)) & Chr(34)
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
x = x + 1
End If
End If
y = y + 1
RS.MoveNext
Loop
End If
objFile.Close
Set objFile = Nothing
Next
Response.Write "Done.<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Created: <a href='hp525hockey/" & Trim(arrTables(i)) & ".csv'>hp525hockey/" & Trim(arrTables(i)) & ".csv" & "<BR>" & VbCrLf
Next
End If%>
</body>
Thanks in advance
The download seems to work however there is no data other than the title fields when you open the file.
Here is the code:
<% Option Explicit %>
<html>
<head>
<title>CSV Export</title>
</head>
<body>
<%
Dim DSNtemp,Conn,RS,action,arrTables,intTable,i,j,x,y, strFields,objFSO,objFile,strLine
'Insert your own DSN info here
DSNtemp="Provider=MSDASQL;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("MYDATABASE") & ";"
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.open DSNtemp,"admin",""
action = Request("action")
If action = "" Then
Set RS = Conn.OpenSchema(20) '--> adSchemaTables = 20
RS.Filter = "TABLE_TYPE = 'TABLE'"
Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getfields"" method=""POST"">" & VbCrLf
Response.Write "Select table(s):<BR>" & VbCrLf
Do While Not RS.EOF
Response.Write "<input type=""checkbox"" name=""tables"" value=""" & RS(2) & """>" & RS(2) & "<BR>" & VbCrLf
RS.MoveNext
Loop
Response.Write "<BR><input type=""submit"" value=""Next >>"">"
RS.Close
Set RS = Nothing
End If
If action = "getfields" Then
arrTables = Split(Replace(Request("tables")," ",""), ",")
Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getrecords"" method=""POST"">" & VbCrLf
Response.Write "<input type=""hidden"" name=""tables"" value=""" & Join(arrTables, ",") & """>" & VbCrLf
Response.Write "<input type=""hidden"" name=""next"" value=""0"">" & VbCrLf
Response.Write "Select field(s):<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Table: " & arrTables(i) & "<BR>" & VbCrLf
Set RS = Conn.Execute("SELECT * FROM " & arrTables(i))
For j = 0 to RS.Fields.Count-1
Response.Write "<input type=""checkbox"" name=""" & arrTables(i) & """ value=""" & RS.Fields(j).Name & """>" & RS.Fields(j).Name & "<BR>" & VbCrLf
Next
RS.Close
Response.Write "<input type=""checkbox"" name=""" & arrTables(i) & """ value=""*"">All Fields<BR>" & VbCrLf
Response.Write "<BR>"
Next
Response.Write "<input type=""submit"" value=""Next >>"">"
Set RS = Nothing
End If
If action = "getrecords" And Not Request("next") = "end" Then
arrTables = Split(Request("tables"), ",")
intTable = Request("next")
If Instr(Request(arrTables(intTable)),"*") = 0 Then strFields = Request(arrTables(intTable)) Else strFields = "*"
Response.Write "<form action=""" & Request.ServerVariables("SCRIPT_NAME") & "?action=getrecords"" method=""POST"">" & VbCrLf
Response.Write "<input type=""hidden"" name=""tables"" value=""" & Request("tables") & """>" & VbCrLf
Response.Write "<input type=""hidden"" name=""table"" value=""" & arrTables(intTable) & """>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "<input type=""hidden"" name=""" & arrTables(i) & """ value=""" & Request(arrTables(i)) & """>" & VbCrLf
Next
If intTable >= 1 Then
For i = 0 to intTable-1
Response.Write "<input type=""hidden"" name=""" & arrTables(i) & "_rec"" value=""" & Replace(Request(arrTables(i) & "_rec")," ", "") & """>" & VbCrLf
Next
End If
If intTable+1 <= UBound(arrTables) Then
Response.Write "<input type=""hidden"" name=""next"" value=""" & intTable+1 & """>" & VbCrLf
Else
Response.Write "<input type=""hidden"" name=""next"" value=""end"">" & VbCrLf
End If
Response.Write "Table: " & arrTables(intTable) & "<BR>" & VbCrLf
Response.Write "Fields: " & strFields & "<BR><BR>" & VbCrLf
Response.Write "Select record(s):<BR>" & VbCrLf
j = 0
Set RS = Conn.Execute("SELECT " & Request(arrTables(intTable)) & " FROM " & arrTables(intTable))
Do While Not RS.EOF
If Instr(Request(arrTables(intTable)), ",") > 0 or Request(arrTables(intTable)) = "*" Then
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""" & j & """>" & Left(RS(0),10) & "," & Left(RS(1),10) & "<BR>" & VbCrLf
Else
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""" & j & """>" & Left(RS(0),10) & "<BR>" & VbCrLf
End If
RS.MoveNext
j = j + 1
Loop
Response.Write "<input type=""checkbox"" name=""" & arrTables(intTable) & "_rec"" value=""ALL"">All records<BR>" & VbCrLf
Response.Write "<BR><input type=""submit"" value=""Next >>"">"
RS.Close
Set RS = Nothing
End If
If action = "getrecords" and Request("next") = "end" Then
Dim arrRecs,strOutput
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
arrTables = Split(Request("tables"), ",")
strOutput = Server.MapPath(".") & "\hp525hockey\" '<-- Edit this to change your output directory
For i = LBound(arrTables) to UBound(arrTables)
Set objFile = objFSO.CreateTextFile(strOutput & Trim(arrTables(i)) & ".csv")
Set RS = Conn.Execute("SELECT " & Request(arrTables(i)) & " FROM " & arrTables(i))
strLine = ""
If Instr(Request(arrTables(i)),"*") = 0 Then
objFile.WriteLine Replace(Request(arrTables(i)), " ", "")
Else
For j = 0 to RS.Fields.Count-1
strLine = strLine & RS.Fields(j).Name
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
End If
If Instr(Request(arrTables(i) & "_rec"), "ALL") <> 0 Then
Do While Not RS.EOF
strLine = ""
For j = 0 to RS.Fields.Count-1
strLine = RS(j)
If isNull(strLine) Then strLine = ""
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
RS.MoveNext
Loop
Else
arrRecs = Split(Replace(Request(arrTables(i) & "_rec")," ",""),",")
x = 0
y = 0
Do While Not RS.EOF
strLine = ""
If Not x > UBound(arrRecs) Then
If y = Int(arrRecs(x)) Then
For j = 0 to RS.Fields.Count-1
If Not IsNull(RS(j)) Then strLine = strLine & Chr(34) & Replace(RS(j), Chr(34), Chr(34) & Chr(34)) & Chr(34)
If j < RS.Fields.Count-1 Then strLine = strLine & ","
Next
objFile.WriteLine strLine
x = x + 1
End If
End If
y = y + 1
RS.MoveNext
Loop
End If
objFile.Close
Set objFile = Nothing
Next
Response.Write "Done.<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Created: <a href='hp525hockey/" & Trim(arrTables(i)) & ".csv'>hp525hockey/" & Trim(arrTables(i)) & ".csv" & "<BR>" & VbCrLf
Next
End If%>
</body>
Thanks in advance