Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

xanburzum

[Resolvido] gerar um csv

Por , em ASP Clássico

Recommended Posts

xanburzum    169

xanburzum
Postado

codigo ASP para gerar um csv.

 

<% Option Explicit %>
<html>
<head>
<title>CSV Export</title>
</head>

<body>
<%

Dim DSNtemp,Conn,RS,action,arrTables,intTable,i,j,x,y,strFields,objFSO,objFile,strLi
ne


DSNtemp="Provider=MSDASQL;DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("./db_dsn.mdb") & ";"

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 "Selecione a(s) tabela(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 "Selecione os campos(s):<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Tabela: " & 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=""*"">Todos os campos<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 "Tabela: " & arrTables(intTable) & "<BR>" & VbCrLf
Response.Write "Campos: " & strFields & "<BR><BR>" & VbCrLf
Response.Write "Selecione os registro(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"">Todos registros<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(".") & "\" '<-- 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
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
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 "Concluido.<BR>" & VbCrLf
For i = LBound(arrTables) to UBound(arrTables)
Response.Write "Criado: " & Server.MapPath(".") & "\" & Trim(arrTables(i)) & ".csv" & "<BR>" & VbCrLf
Next
End If
%>
</body>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito