Visual Basic - Urgente: generar fichero de texto

Life is soft - evento anual de software empresarial
 
Vista:

Urgente: generar fichero de texto

Publicado por aristegui (2 intervenciones) el 31/05/2001 12:07:24
Buenas, me ha caido una encima buena, soy Programador de Lotus Notes pero me han mandado hacer en Visual Basic 6 lo siguiente, coger unos datos de excel y con ellos generar un fichero plano de texto con un determinado formato ¿ alguien me recomienda como proceder, alguien ha hecho algo parecido y puede pasarme el código ? Si me podeis recomendar páginas de VB, manuales, código ( en castellano o no ) lo agradecería muchísimo. Gracias de antemano.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Urgente: generar fichero de texto

Publicado por jc (22 intervenciones) el 11/06/2001 18:38:23
La 1ª función (ExisteFicheroTxt) comprueba si existe un fichero determinado en una ruta determinada. La ruta y el fichero lo pasas a la función.

Si existe el fichero y deseas borrarlo pones Kill ruta más fichero.txt.

la 2ª parte simplemente abre y escribe en el fichero

Public Function ExisteFicheroTxt(ByVal sruta As String, sFichero As String) As Boolean

Dim miRuta, MiNombre
Dim dblPosicionLibre As Double 'Nos da la primera posición libre _
de memoria para guardar el fichero


ExisteFicheroTxt = False

miRuta = sruta ' Establece la ruta.
MiNombre = Dir(miRuta, vbDirectory) ' Recupera la primera entrada.
Do While MiNombre <> "" ' Inicia el bucle.
' Ignora el directorio actual y el que lo abarca.
If MiNombre <> "." And MiNombre <> ".." Then
' Realiza una comparación a nivel de bit para asegurarse de que MiNombre es un directorio.
If (GetAttr(miRuta & MiNombre) And vbArchive) = vbArchive Then
If MiNombre = sFichero Then
ExisteFicheroTxt = True ' Muestra la entrada
Exit Do
End If
End If ' solamente si representa un directorio.
End If
MiNombre = Dir ' Obtiene siguiente entrada.
Loop

End Function

'***********************************************
dim sRutatxt as string
dim sFichero as string

sRutatxt ="c:\" 'por ejemplo
sFichero ="fichero.txt"

Open sRutatxt & sFichero For Ou
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Urgente: generar fichero de texto

Publicado por jc (22 intervenciones) el 11/06/2001 18:38:38
La 1ª función (ExisteFicheroTxt) comprueba si existe un fichero determinado en una ruta determinada. La ruta y el fichero lo pasas a la función.

Si existe el fichero y deseas borrarlo pones Kill ruta más fichero.txt.

la 2ª parte simplemente abre y escribe en el fichero

Public Function ExisteFicheroTxt(ByVal sruta As String, sFichero As String) As Boolean

Dim miRuta, MiNombre
Dim dblPosicionLibre As Double 'Nos da la primera posición libre _
de memoria para guardar el fichero


ExisteFicheroTxt = False

miRuta = sruta ' Establece la ruta.
MiNombre = Dir(miRuta, vbDirectory) ' Recupera la primera entrada.
Do While MiNombre <> "" ' Inicia el bucle.
' Ignora el directorio actual y el que lo abarca.
If MiNombre <> "." And MiNombre <> ".." Then
' Realiza una comparación a nivel de bit para asegurarse de que MiNombre es un directorio.
If (GetAttr(miRuta & MiNombre) And vbArchive) = vbArchive Then
If MiNombre = sFichero Then
ExisteFicheroTxt = True ' Muestra la entrada
Exit Do
End If
End If ' solamente si representa un directorio.
End If
MiNombre = Dir ' Obtiene siguiente entrada.
Loop

End Function

'***********************************************
dim sRutatxt as string
dim sFichero as string

sRutatxt ="c:\" 'por ejemplo
sFichero ="fichero.txt"

Open sRutatxt & sFichero For Ou
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:tienes un correo

Publicado por jc (1 intervención) el 11/06/2001 18:54:05
Te he enviado un mail a tu correo pues aquí no cabe todo. Siento haberme extendido tanto. Un saludo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Urgente: generar fichero de texto

Publicado por Omar A. (1 intervención) el 12/06/2001 21:08:35

Aqui te envio parte del codigo con el cual genero un plano apartir de una cadena espero te sirva}

Public Sub xx()
On Error GoTo Falla
Dim Mparametros, Mregistros, FileDTempo, FileFTempo As String
Dim registro, Nombre, empresa, ano, mes, mesf, dia, diaf As String
Dim i As Integer
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set Fs = CreateObject("Scripting.FileSystemObject")

MRutaUsu1 = ppIdDBMS ' Id Auxiliar del vendedor
MRutaPedido = "S:\QDLS\PEDIDO2\" ' & MRutaUsu ' Ruta en la cual quedan Arch. Planos

'NumError = 0
'VHError = ""

If Left(UCase(Parametros), 7) = "DETALLE" Then
Dim a As Variant
Set Fs = CreateObject("Scripting.FileSystemObject")
FileDTempo = MRutaPedido + "IT" + MRutaUsu1 + ".TXT"
Set a = Fs.OpenTextFile(FileDTempo, ForAppending, True)
Mparametros = Parametros
Mregistros1 = Registros
a.Write (Mregistros1)
'+ Chr(13) + Chr(10) Saltar Registro
a.Close
If Right(Registros, 3) = "DHS" Then
Call PlanoIt("Detalle")
End If
End If
End Sub

Public Sub PlanoIt(Detalle As String)

On Error GoTo Falla1
Dim FileDTempo As String
Dim registro, Nombre, empresa, ano, mes, mesf, dia, diaf As String
Dim i As Integer, NumArch
Dim Myrecord As String * 32000
Dim Gorro1, Gorro2, cadena1, Corchete, Cadena0, Cadena As String
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set Fs = CreateObject("Scripting.FileSystemObject")

MRutaUsu1 = ppIdDBMS ' Id Auxiliar del vendedor
MRutaPedido = "S:\QDLS\PEDIDO2\" ' & MRutaUsu ' Ruta en la cual quedan Arch. Planos

'NumError = 0
'VHError = ""
i = 1
NumArch = FreeFile
FileDTempo = MRutaPedido + "IT" + MRutaUsu1 + ".TXT"
Open (FileDTempo) For Random As NumArch Len = Len(Myrecord)
i = 1
Do While Not EOF(NumArch)
Get #1, i, Myrecord
Mregistros1 = Myrecord
'MsgBox (Myrecord)
'Debug.Print MyRecord
i = i + 1
Loop
Close #1

Call Buscar("Detalle")
Filedetalle = MFencab
Dim b As Variant
Set b = Fs.CreateTextFile(Filedetalle, True)
'Mregistros1 = "~1|0025762|545025700||1||10500|525|0|0|997|1522|10414|1436|10500}~1|0025762|533009005|B|5||22625||||||||4525}~1|0025762|545025702||1||10500|525|0|0|997|1522|10414|1436|10500}~1|0025762|545025702||1||10500|525|0|0|997|1522|10414|1436|10500}~1|0025762|545025701||15||157500|7875|0|0|14962|22837|156209|21546|10500}~2|0009816|545255051||1||7980|399|0|0|758|1157|7914|1091|7980}~2|0009816|198000003||8||84000||||||||10500}~2|0009816|255000730||||0||||||||6000}~"
' *******************
' * Cadena de Items *
' *******************
Cadena = Mregistros1
Tamano = Len(Cadena)
Cad_bus = "|"
Sw = 0
While Sw = 0
Gorro1 = "~"
Gorro2 = "~"
Gorro1 = InStr(1, Cadena, Gorro1, 1) + 1
Gorro2 = InStr(Gorro1, Cadena, Gorro2, 1)
cadena1 = ""
Cadena0 = Mid(Cadena, Gorro1, (Gorro2 - Gorro1))
Gorro0 = "}"
Gorro0 = InStr(1, Cadena0, Gorro0, 1) + 1
cadena1 = Cadena0
Palos = "|"
' Numero Pedido
Palo1 = InStr(1, cadena1, Palos, 1)
Campo1 = Left(cadena1, Palo1 - 1)
Tcampo = 10
Call Espacios(Tcampo, (Campo1))
.
.
.
.

Acampos1 = CStr(Campo1) + CStr(Campo2) + CStr(Campo3) + CStr(Campo4) + CStr(Campo5) + CStr(Campo6) + CStr(Campo7) + _
CStr(Campo8) + CStr(Campo9) + CStr(Campo10) + CStr(Campo11) + CStr(Campo12) + _
CStr(Campo16) + CStr(Campo14) + CStr(Campo15)
b.Write (Acampos1) + Chr(13) + Chr(10)
.
.
.
.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar