Ir para conteúdo

POWERED BY:

Arquivado

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

Ronaldo Faria Storck Eler

erro no FSO

Recommended Posts

Olá, estou precisando gravar em um arquivo, no entanto, após abrir com o fso, busco uma função, e dentro dela é que está o comando WriteLine, mas não funciona. Como contornar?

 

Função que grava o arquivo:

Sub GeraArquivo(prefixo, nomearquivo)


	On Error Resume Next
	sFolder = ""
	sFn = (prefixo, & "_" & nomearquivo & ".txt"
	Set fso = Server.Createobject("Scripting.FileSystemObject")
	bWriteHeader = Not fso.FileExists(Server.MapPath(sFolder & sFn))
	Set ArquivoTxt = fso.OpenTextFile(Server.MapPath(sFolder & sFn), 8, True)
	If bWriteHeader Then
		call geraCabecalho
	End If
		Call geraLinhas


	ArquivoTxt.Close
	Set ArquivoTxt  = Nothing
	Set fso = Nothing
End Sub

call GeraArquivo("cidade", "contratos")

 

Função que puxa os dados:

 

	Public Sub geraLinhas()
		Dim html
		html = 	"001"					
		html = html & "9999"				
		html = html & "9"				
		html = html & preenche(9, true)			
		html = html & ""				
		html = html & ""				
		html = html & ""				
		html = html & preenche(205, true)		
	        'aqui era para escrever no arquivo que já está aberto pela funcao GeraArquivos
		ArquivoTxt.WriteLine(html)
	End Sub

A função cria o arquivo (caso ele não exista), mas fica em branco, a função não consegue popular o arquivo txt...

 

Se alguem tiver dicas, agradeço!

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

qual o número do erro gerado ?

 

veja se as permissões nos arquivos estão corretas

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bem, não gera erro algum, esse é o problema... sei que o erro é no ArquivoTxt.WriteLine(html) porque coloquei um response.write antes e outro depois, e ele não executa...

 

Sobre as permissões, imagino que estejam ok, pois estou conseguindo gravar um novo arquivo... se, ao inves de colocar na sub geraLinhas colocar diretamente dentro da sub GeraArquivo, funciona blz... mas preciso separar as partes pois as usarei várias vezes...

 

Fiz algumas modificações, com códigos encontrados aqui mesmo no fórum, mas mesmo assim, nada...

 

<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!doctype html>
<html>
<head>
<meta charset="iso-8859-1">
<title>Documento sem título</title>
</head>

<body>
<%

function w(texto)
	Response.write texto
end function

function preenche(t,p)
	strPreenchimento = ""
	
	if p then 'p = true, significa "brancos
		for i = 0 to t - Len(m)
  			strPreenchimento = strPreenchimento & " "'String(t - Len(m), " ") & m
		next
	else
		for i = 0 to t - Len(m)
	  		strPreenchimento = strPreenchimento & "0" 'String(t - Len(m), "0") & m
		next
	end if
	preenche = strPreenchimento
end function

Function complementoRegistro(m, t, p, a)
	'm - string
	't - tamanho máximo
	'p - tipo de preenchimento, 0 ou brancos
	'a - alinhamento
	strPreenchimento = ""
	
	if p then 'p = true, significa "brancos
		for i = 0 to t - Len(m)
  			strPreenchimento = strPreenchimento & " "'String(t - Len(m), " ") & m
		next
	else
		for i = 0 to t - Len(m)
	  		strPreenchimento = strPreenchimento & "0" 'String(t - Len(m), "0") & m
		next
	end if
	
	if a then 'alinhamento = true, significa, esquerda
		complementoRegistro = m & strPreenchimento
	else
		complementoRegistro = strPreenchimento & m
	end if
End Function

w complementoRegistro("-ronaldo",6, true, true)&vbcrlf
w complementoRegistro("-ronaldo",10, true, true)&vbcrlf
w complementoRegistro("-ronaldo",10, false, true)&vbcrlf
w complementoRegistro("-ronaldo",10, false, false)&vbcrlf

'#############################################################################################
	'[START] Gera o arquivo da remessa BB
	'#############################################################################################
	Sub geraHeaderArquivo()
		Dim html
		html = 	"001"											'CODIGO DO BANCO NA COMPENSACAO			001
		html = html & "0000"									'LOTE DE SERVICO						0000
		html = html & "0"										'REGISTRO HEADER DE ARQUIVO				0
		html = html & preenche(9, true)			'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
		html = html & "2"										'TIPO DE INSCRICAO DA EMPRESA			1-CPF 2-CGC
		html = html & complementoRegistro("36403954000192", 14, true, true)						'Nº. DE INSCRICAO DA EMPRESA			
		html = html & preenche(20, true)		'CODIGO DO CONVENIO NO BANCO			
		html = html & "3435"									'AGENCIA MANTENEDORA DA CONTA			
		html = html & ""										'DIGITO VERIFICADOR DA AGENCIA			
		html = html & ""										'NUMERO DA CONTA CORRENTE				
		html = html & ""										'DIGITO VERIFICADOR DA CONTA			
		html = html & ""										'DIGITO VERIFICADOR DA AG/CONTA			
		html = html & ""										'NOME DA EMPRESA						
		html = html & ""										'NOME DO BANCO							
		html = html & preenche(10, true)		'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
		html = html & ""										'CODIGO REMESSA / RETORNO				1-REM 2-RET
		html = html & ""										'DATA DE GERACAO DO ARQUIVO				DDMMAAAA
		html = html & ""										'HORA DE GERACAO DO ARQUIVO				HHMMSS
		html = html & ""										'Nº. SEQUENCIAL DO ARQUIVO				
		html = html & "030"										'Nº. DA VERSAO DO LAYOUT DO ARQUIVO		030
		html = html & ""										'DENSIDADE DE GRAVACAO DO ARQUIVO		
		html = html & ""										'PARA USO RESERVADO DO BANCO			
		html = html & ""										'PARA USO RESERVADO DA EMPRESA			
		html = html & preenche(11, true)		'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
		html = html & "CSP"										'IDENTIFICACAO COBRANCA S/PAPEL			'CSP'
		html = html & ""										'USO EXCLUSIVO DAS VANS					
		html = html & ""										'TIPO DE SERVICO						
		html = html & ""										'CODIGOS DAS OCORRENCIAS				
		
		w "ali"
		ArquivoTxt.WriteLine(html)
		response.write "aqui"
		response.End()
		w html
	End Sub
	
	Public Sub geraHeaderLote()
		Dim html
		html = ""												'CODIGO DO BANCO NA COMPENSACAO
		html = html & ""										'LOTE DE SERVICO
		html = html & ""										'REGISTRO HEADER DO LOTE
		html = html & ""										'TIPO DE OPERACAO
		html = html & ""										'TIPO DE SERVICO
		html = html & ""										'FORMA DE LANCAMENTO
		html = html & ""										'No.DA VERSAO DO LAYOUT DO LOTE
		html = html & ""										'USO EXCLUSIVO FEBRABAN/CNAB
		html = html & ""										'TIPO DE INSCRICAO DA EMPRESA
		html = html & ""										'No.DE INSCRICAO DA EMPRESA
		html = html & ""										'CODIGO DO CONVENIO NO BANCO
		html = html & ""										'AGENCIA MANTENEDORA DA CONTA
		html = html & ""										'DIGITO VERIFICADOR DA AGENCIA
		html = html & ""										'NUMERO DA CONTA CORRENTE
		html = html & ""										'DIGITO VERIFICADOR DA CONTA
		html = html & ""										'DIGITO VERIFICADOR DA AG/CONTA
		html = html & ""										'NOME DA EMPRESA
		html = html & ""										'MENSAGEM 1
		html = html & ""										'MENSAGEM 2
		html = html & ""										'NUMERO REMESSA/RETORNO
		html = html & ""										'DATA DE GRAVACAO REMESSA/RETORN
		html = html & ""										'DATA DO CREDITO
		html = html & ""										'USO EXCLUSIVO FEBRABAN/CNAB
		
		ArquivoTxt.WriteLine(html)
		w html
	End Sub
	
	Public Sub geraRemessa()
		ArquivoTxt.WriteLine(html)
		w html
	End Sub
	
	Public Sub geraTrailerLote()
		Dim html
		html = 	""												'CODIGO DO BANCO NA COMPENSACAO
		html = html & ""										'LOTE DE SERVICO
		html = html & ""										'REGISTRO TRAILER DO LOTE
		html = html & ""										'USO EXCLUSIVO FEBRABAN/CNAB
		html = html & ""										'QUANTIDADE DE REGISTROS DO LOTE
		html = html & ""										'QUANTIDADE DE TIT. EM COBRANCA
		html = html & ""										'VALOR TOT. DOS TIT. EM CARTEIRA
		html = html & ""										'QUANTIDADE DE TIT. EM COBRANCA
		html = html & ""										'VALOR TOT DOS TIT. EM CARTEIRAS
		html = html & ""										'QUANTIDADE DE TIT. EM COBRANCA
		html = html & ""										'VALOR TOT DOS TIT. EM CARTEIRAS
		html = html & ""										'QUANTIDADE DE TIT. EM COBRANCA
		html = html & ""										'VALOR TOT DOS TIT. EM CARTEIRAS
		html = html & ""										'NUMERO DO AVISO DE LANCAMENTO
		html = html & ""										'USO EXCLUSIVO FEBRABAN/CNAB
	
		ArquivoTxt.WriteLine(html)
		w html
	End Sub

	Public Sub geraTrailerArquivo()
		Dim html
		html = 	"001"						'					'CODIGO DO BANCO NA COMPENSACAO			001
		html = html & "9999"									'LOTE DE SERVICO						9999
		html = html & "9"										'REGISTRO TRAILER DE ARQUIVO			9
		html = html & preenche(9, true)			'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
		html = html & ""										'QUANTID. DE LOTES DO ARQUIVO			NUM. REGIST. TIPO - 1
		html = html & ""										'QUANTID. DE REGISTROS DO ARQUIV		NUM. REG. TIPOS 0+1+3+5+9
		html = html & ""										'QTDADE DE CONTAS P/CONC.- LOTES		NUM. REG. TIPO-1 OPER-E
		html = html & preenche(205, true)		'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
	
		ArquivoTxt.WriteLine(html)
		w html
	End Sub
	
	Public Sub addRemessa()
		'Gera os dados da remessa
		Call geraHeaderArquivo	
		Call geraHeaderLote
		Call geraRemessa	
		Call geraTrailerLote
		Call geraTrailerArquivo
	
	End Sub
	'#############################################################################################
	'[END] Cria o arquivo de remessa BB
	'#############################################################################################
	
	Function ewZeroPad(m, t)
  ewZeroPad = String(t - Len(m), "0") & m
End Function


Sub GeraArquivo(pfx, nomearquivo, curDate, curTime, id, user)

'w pfx &vbcrlf
'w nomearquivo &vbcrlf
'w curDate &vbcrlf
'w curTime &vbcrlf
'w id &vbcrlf
'w user &vbcrlf

	
	On Error Resume Next
	Dim fso, ArquivoTxt, sMsg, sFn, sFolder
	Dim bWriteHeader, sHeader
	Dim userwrk
	userwrk = user
	
	If userwrk = "" Then userwrk = "-1" ' assume Administrator if no user
	'caminho
	sFolder = ""
	sFn = pfx & "_" & ewZeroPad(Day(Date), 2) & ewZeroPad(Month(Date), 2) &  ewZeroPad(Year(Date), 4) & ".txt"
	Set fso = Server.Createobject("Scripting.FileSystemObject")
	bWriteHeader = Not fso.FileExists(Server.MapPath(sFolder & sFn))
	Set ArquivoTxt = fso.OpenTextFile(Server.MapPath(sFolder & sFn), 8, True)
	If bWriteHeader Then
		'ArquivoTxt.writeline(sHeader)
		call geraHeaderArquivo
	End If
			call geraHeaderArquivo
		Call geraHeaderLote
		Call geraRemessa	
		Call geraTrailerLote
		Call geraTrailerArquivo
	'ArquivoTxt.writeline(sMsg)
	ArquivoTxt.Close
	Set ts = Nothing
	Set fso = Nothing
End Sub

call GeraArquivo("prefixo", "contrato2", date(), time(), 1, 1)

%>
</body>
</html>

 

sds

Compartilhar este post


Link para o post
Compartilhar em outros sites

realmente é na estrutura de montagem de seu WriteLine, provavelmente uma concatenação... terás que fazer um teste de mesa atribuindo as concatenações para encontrar o erro

Compartilhar este post


Link para o post
Compartilhar em outros sites

obrigado pelo retorno, mas se fosse na estrutura quando colocasse o código dentro da sub gera arquivo, daria erro, mas funciona:

 

	Set ArquivoTxt = fso.OpenTextFile(Server.MapPath(sFolder & sFn), 8, True)
	If bWriteHeader Then
		'ArquivoTxt.writeline(sHeader)
		call geraHeaderArquivo
	End If
		
		html = 	"001"						'					'CODIGO DO BANCO NA COMPENSACAO			001
		html = html & "9999"									'LOTE DE SERVICO						9999
		html = html & "9"										'REGISTRO TRAILER DE ARQUIVO			9
		html = html & preenche(9, true)			'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
		html = html & ""										'QUANTID. DE LOTES DO ARQUIVO			NUM. REGIST. TIPO - 1
		html = html & ""										'QUANTID. DE REGISTROS DO ARQUIV		NUM. REG. TIPOS 0+1+3+5+9
		html = html & ""										'QTDADE DE CONTAS P/CONC.- LOTES		NUM. REG. TIPO-1 OPER-E
		html = html & preenche(205, true)		'USO EXCLUSIVO FEBRABAN/CNAB			BRANCOS
	
		ArquivoTxt.WriteLine(html)
		
		Call geraHeaderLote
		Call geraRemessa	
		Call geraTrailerLote
		Call geraTrailerArquivo
	'ArquivoTxt.writeline(sMsg)
	ArquivoTxt.Close

Portanto, penso que a sub não esta recebendo a instanciação do fso que é feita antes da sua chamada, ou algo do tipo... alguma ideia?

 

sds

Compartilhar este post


Link para o post
Compartilhar em outros sites

o que esta vindo na variável preenche

Compartilhar este post


Link para o post
Compartilhar em outros sites

Preenche e complementoRegistro são funções, para tratar cada campo e preencher com brancos ou zeros, de acordo com a orientação...

function preenche(t,p)	't - tamanho máximo	'p - tipo de preenchimento, 0 ou brancos	strPreenchimento = ""		if p then 'p = true, significa "brancos		for i = 0 to t - Len(m)  			strPreenchimento = strPreenchimento & " "'String(t - Len(m), " ") & m		next	else		for i = 0 to t - Len(m)	  		strPreenchimento = strPreenchimento & "0" 'String(t - Len(m), "0") & m		next	end if	preenche = strPreenchimentoend functionFunction complementoRegistro(m, t, p, a)	'm - string	't - tamanho máximo	'p - tipo de preenchimento, 0 ou brancos	'a - alinhamento	strPreenchimento = ""		if p then 'p = true, significa "brancos		for i = 0 to t - Len(m)  			strPreenchimento = strPreenchimento & " "'String(t - Len(m), " ") & m		next	else		for i = 0 to t - Len(m)	  		strPreenchimento = strPreenchimento & "0" 'String(t - Len(m), "0") & m		next	end if		if a then 'alinhamento = true, significa, esquerda		complementoRegistro = m & strPreenchimento	else		complementoRegistro = strPreenchimento & m	end ifEnd Function

 

Bem, como sou adepto do "se não sabe escrever sessenta, faz dois cheques de 30", fiz algo, que não sei se é o correto, em termos de performance e lógica, mas deu certo:

 

 

 

- converti as sub que montam as linhas () em functions:

	Function geraTrailerArquivo()				html = 	"001"									        html = html & "9999"						html = html & "9"									html = html & preenche(9, true)					html = html & ""		html = html & preenche(205, true)			'ArquivoTxt.WriteLine(html)		geraTrailerArquivo = html	End Function 

- depois de chamar a função, faço a escrita:

call geraTrailerArquivoArquivoTxt.WriteLine(geraTrailerArquivo)

Se alguém tiver algo 'mais correto" para me passar, agradeço...

Compartilhar este post


Link para o post
Compartilhar em outros sites

eu ia pedir para verificar o retorno da função preenche...

Mais se a POG resolveu e não etsa interferindo em nada no desempenho,

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

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