Gerar arquivo CSV

Mário Monteiro · Outubro 3, 2008

Mas o problema nao é do ASP se o codigo foi mal feito

É injusto atribuir isto a linguagem

mibnetweb · Outubro 3, 2008

Tentei fazer umas "arrumações". testa ai !!!!

<% Option Explicit %>
<html>
<head>
<title>Salvar</title>
</head>

<body>
<%

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


DSNtemp="DRIVER={MySQL ODBC 3.51 Driver};SERVER=mysql1.prv.f3.k8.com.br;PORT=3306;DATABASE=espiritosanta;USER=esp
iritosanta;PASSWORD=654321;OPTION=3;"

Set Conn = Server.CreateObject("ADODB.Connection")
Conn.open DSNtemp,"espiritosanta","654321"

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 newsletter ")
		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")

	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 * FROM newsletter")
	Do While Not RS.EOF
		If Instr(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


		'Aqui fica o fim, pra onde eu quero que seja redirecionado todas as variáveis.



	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 * FROM newsletter ")
			strLine = ""


			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)
						end if	
						If j < RS.Fields.Count-1 Then 
							strLine = strLine & ","
						end if	
				   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)
								end if	
								If j < RS.Fields.Count-1 Then 
									strLine = strLine & ","
								end if	
							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
	End If
End if	
	
%>
</body>
</html>

gotaum · Outubro 3, 2008

Pessoal, acho que a comunicação por minha parte está falha, se possível entrem no link:

http://www.espiritosanta.com.br/imprime.asp

Ai está o código funcionando perfeitamente.

O problem é que eu não quero que o meu cliente acesse tres etapas para escolher todos os arquivos da tabela e depois ainda tenha que salvar... o meu desejo é que assim que ele for redirecionado para essa página ele vá direto pra a parte salvar como... é só isso...

O cliente sempre vai salvar o arquivo completo, com todas as linhas do cadastro.

Até breve povo!!!!

gotaum · Outubro 6, 2008

Galera fuçando na net achei um script que resolveu meus problemas!!!!

Segue ai pra quem quiser usar e o link onde encontrei!!!!!

<%@ Language=VBScript %> 
<% 
' GenerateXLS Version 1.0 by Brian Kirsten (bkirsten@brainscanstudios.com) 
' 1st modified 11/29/00 
' 2nd modification 10/25/02 
' copyright Ó 2000 Brain Scan Studios, Inc. (http://www.brainscanstudios.com) 
' source distributed under the gnu general public license. 
' let me know if your site is using the code i will put a link up to your page! 

Dim sTable 
Dim sDSN 
Dim sFields 


sFields = "<FIELDS>" 'os seus campos na tabela
sTable = "<TABLE_NAME>" 'nome da sua tabela 

Set DB = Server.CreateObject("ADODB.Connection") 
Set RS = Server.CreateObject("ADODB.Recordset") 

DB.Open("DRIVER={MySQL ODBC 3.51 Driver};SERVER=seu server;PORT=3306;DATABASE=seu banco;USER=login;PASSWORD=senha;OPTION=3;")

RS.Open "select "& sFields &" from "& sTable,DB 

Response.ContentType = "application/csv" 
Response.AddHeader "Content-Disposition", "filename=mydata.csv;" 
' lets print the fields on top 

for i = 0 to RS.Fields.Count-1 
if i = (RS.Fields.Count - 1) then 
Response.Write lcase(RS.Fields(i).Name) 
else 
Response.Write lcase(RS.Fields(i).Name) & "," 
end if 
next 

Response.write vbNewLine 
Response.write vbNewLine 

while not RS.EOF 

for u=0 to RS.Fields.Count - 1 
if u = (RS.Fields.Count - 1) then 
Response.Write RS.Fields(u).Value 
else 
Response.Write RS.Fields(u).Value & "," 
end if 
next 

response.write vbNewLine 

rs.MoveNext 
wend 

Response.write vbNewLine 
Response.write vbNewLine 

Set RS = Nothing 
Set DB = Nothing 

%>

o link: http://www.criarweb.com/artigos/706.php

valeu pra todos, só um detalhe... nessa linha:

Response.Write lcase(RS.Fields(i).Name) & ","

e nessa,

Response.Write RS.Fields(u).Value & ","

substituam a virgula "," por ponto e virgula ";", senão a tabela vai ficar numa célula só em cada linha.

até mais... e considero o tópico fechado

Entrar

Arquivado

Gerar arquivo CSV

Recommended Posts

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

mibnetweb 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

gotaum 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

gotaum 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

PHP+Codeigniter - Dúvida referente a PDV

PHP+Codeigniter - Dúvida em Relação a Teclas

Conexão mysql com outro domínio

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante