Exportar datos de excel por VBA

hola, Jaime !

Mostrar la cita

... objetivo ... genere un archivo de texto con ciertos espacios determinados [...]

[segun lo que se ve...] el 'detalle' esta en los =>espacios<= 'de separacion' entre las columnas 2 y 3
para 'llenar' con los espacios 'faltantes' entre un numero 'dado' y el largo de la columna 3
y [al parecer...] no encontraste 'como adaptar' la sugerencia de usar una sentencia String(15, " "-etc- [...]

una forma de 'aprovecharla' es la siguiente:
1° agrega/declara otra variable de tipo string para los espacios que 'separan' cada columna [p.e. strSpc]
2° 'intercepta' la columna 2 en el primer bucle ['For N = 1 To intContC'] y 'modifica' la cantidad de espacios 'finales'
que seran los que 'separen' las columnas 2 y 3 [con los espacios 'faltantes' segun el largo de la columna 3]
=> esto podrias hacerlo con una sentencia del tipo 'If...']

prueba con estas 'sugerencias' y tu macro ['adaptada'] quedaria +/- como sigue:
[obviamente, el archivo 'resultante' sera 'mejor visto' con un tipo de fuente de 'ancho fijo']
¿comentas?
saludos,
hector.
_____________________
Sub ExportarDelimitado()
Dim strSpc As String '<== la nueva variable propuesta
Dim HojaPol As Worksheet
Dim intFich As Integer, lngNumReg As Long, strCad As String, strCar As String * 1
Dim lngContL As Long, intContC As Integer, N As Long
Set HojaPol = Worksheets("polcont") 'hoja donde estan los datos
intFich = FreeFile(0)
lngContL = 1 'se empezara a exportar en la fila 2 (se entiende que la 1ª es de títulos)
intContC = 6 'se exportaran las columnas 1 a 6
If Dir("C:\Fichero.txt") <> "" Then Kill ("C:\Fichero.txt") 'si ya existe C:\Fichero.txt, lo borra.
Open "C:\Fichero.txt" For Random As intFich Len = 1
While Not IsEmpty(HojaPol.Cells(lngContL, 1))
For N = 1 To intContC
If intContC = 2 Then '<== el If 'interceptor' de la columna 2
strSpc = String(10 - Len(HojaPol.Cells(lngContL, N + 1)), " ") '<== 'habra' 10 espacios MENOS los que ocupe la col. 3
Else: strSpc = " " '<== para todos los demas casos, las columnas se separan por solo un espacio
End If
strCad = strCad & Format(HojaPol.Cells(lngContL, N), HojaPol.Cells(lngContL, N).NumberFormat) & strSpc '<== los 'necesarios'
Next N
strCad = Left(strCad, Len(strCad) - 1) & vbNewLine 'para quitar el ultimo delimitador por la derecha y añadir el salto de linea
For N = 1 To Len(strCad)
strCar = Mid(strCad, N, 1)
lngNumReg = lngNumReg + 1
Put intFich, lngNumReg, strCar
Next N
lngContL = lngContL + 1
strCad = ""
Wend
Close intFich
Set HojaPol = Nothing
End Sub

Hector buen dia,
probe con el codigo que me hiciste favor de modificar y
te comento que aun sigue creando el archivo de la misma
forma en que lo venia haciendo, si gustas puedo enviarte
la macro, junto con los datos que exporta para que veas
como genera el archivo , asi tambien te envio un ejemplo
de como debe generarlo,

solo necesito me proporciones un correo a donde
enviartelo.

gracias.

Mostrar la cita

hola, Jaime !

Mostrar la cita

... objetivo ... genere un archivo de texto con

ciertos espacios determinados [...]
Mostrar la cita

[segun lo que se ve...] el 'detalle' esta en los

=>espacios<= 'de separacion' entre las columnas 2 y 3
Mostrar la cita

para 'llenar' con los espacios 'faltantes' entre un

numero 'dado' y el largo de la columna 3
Mostrar la cita

y [al parecer...] no encontraste 'como adaptar' la

sugerencia de usar una sentencia String(15, " "-etc- [...]
Mostrar la cita

una forma de 'aprovecharla' es la siguiente:
1° agrega/declara otra variable de tipo string para los

espacios que 'separan' cada columna [p.e. strSpc]
Mostrar la cita

2° 'intercepta' la columna 2 en el primer bucle ['For N

= 1 To intContC'] y 'modifica' la cantidad de
espacios 'finales'
Mostrar la cita

que seran los que 'separen' las columnas 2 y 3 [con

los espacios 'faltantes' segun el largo de la columna 3]
Mostrar la cita

=> esto podrias hacerlo con una sentencia del

tipo 'If...']
Mostrar la cita

prueba con estas 'sugerencias' y tu macro ['adaptada']

quedaria +/- como sigue:
Mostrar la cita

[obviamente, el archivo 'resultante' sera 'mejor visto'

con un tipo de fuente de 'ancho fijo']
Mostrar la cita

¿comentas?
saludos,
hector.
_____________________
Sub ExportarDelimitado()
Dim strSpc As String '<== la nueva variable propuesta
Dim HojaPol As Worksheet
Dim intFich As Integer, lngNumReg As Long, strCad As

String, strCar As String * 1
Mostrar la cita

Dim lngContL As Long, intContC As Integer, N As Long
Set HojaPol = Worksheets("polcont") 'hoja donde estan

los datos
Mostrar la cita

intFich = FreeFile(0)
lngContL = 1 'se empezara a exportar en la fila 2 (se

entiende que la 1ª es de títulos)
Mostrar la cita

intContC = 6 'se exportaran las columnas 1 a 6
If Dir("C:\Fichero.txt") <> "" Then Kill

("C:\Fichero.txt") 'si ya existe C:\Fichero.txt, lo borra.
Mostrar la cita

Open "C:\Fichero.txt" For Random As intFich Len = 1
While Not IsEmpty(HojaPol.Cells(lngContL, 1))
For N = 1 To intContC
If intContC = 2 Then '<== el If 'interceptor' de

la columna 2
Mostrar la cita

strSpc = String(10 - Len(HojaPol.Cells(lngContL,

N + 1)), " ") '<== 'habra' 10 espacios MENOS los que
ocupe la col. 3
Mostrar la cita

Else: strSpc = " " '<== para todos los demas

casos, las columnas se separan por solo un espacio
Mostrar la cita

End If
strCad = strCad & Format(HojaPol.Cells(lngContL,

N), HojaPol.Cells(lngContL, N).NumberFormat) &
strSpc '<== los 'necesarios'
Mostrar la cita

Next N
strCad = Left(strCad, Len(strCad) - 1) &

vbNewLine 'para quitar el ultimo delimitador por la
derecha y añadir el salto de linea
Mostrar la cita

For N = 1 To Len(strCad)
strCar = Mid(strCad, N, 1)
lngNumReg = lngNumReg + 1
Put intFich, lngNumReg, strCar
Next N
lngContL = lngContL + 1
strCad = ""
Wend
Close intFich
Set HojaPol = Nothing
End Sub

.

hola, Jaime !

Mostrar la cita

... enviarte la macro, junto con los datos que exporta ... solo necesito ... un correo a donde enviartelo.

solamente quita de la direccion de respuesta el 'NO...SPAM...PLS' ;)

saludos,
hector.

Buen dia hector,

te envie la informacion de la macro , me gustaria saber
si la recibiste o no , en caso de q sea afirmativo , que
sugerencia me puedes dar para el datalle que tengo

gracias

Jaime