Guardar macro separados por ";" y no por "|"

Para Dante Amor

Hola Dante me conseguí una macro y lo adapte a lo que necesito; pero al momento de guardar el archivo los datos de cada columna me los separa por"|", y yo quisiera que me ayudes para que me guarde separados por ";"

Option Private Module
Public Ruta As String
#If VBA7 And Win64 Then

Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As LongPtr
lpfn As LongPtr
lParam As LongPtr
iImage As LongPtr
End Type

'Si es de 64 bits
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
'Si es de 32 bits
Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
#End If

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
#If VBA7 And Win64 Then
'Si es de 64 bits
Dim bInfo As BROWSEINFO, path As String, r As LongPtr
Dim X As LongPtr, pos As Integer
#Else
'Si es de 32 bits
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
#End If
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Seleccione una Carpeta"
' the dialog title
Else
bInfo.lpszTitle = "¿En que carpeta desea guardar el Archivo a generar?" ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1) & "\"
If Right(GetFolderName, 2) = "\\" Then GetFolderName = Left(GetFolderName, Len(GetFolderName) - 1)
Else
GetFolderName = ""
End If
End Function

Sub TestGetFolderName()
Dim FolderName As String
FolderName = GetFolderName("Select a folder")
If FolderName = "" Then
MsgBox "No has seleccionado una carpeta válida" & Chr(13) & "Por defecto se seleccionará el disco C:/", vbCritical, "SELECCIONE UNA CARPETA"
Ruta = "C:\"
Else
Ruta = FolderName
End If
End Sub

Sub Procesar()
Call TestGetFolderName
Call Colocar_Formula
Call Arrastre
Call Guardar_txt
End Sub

Sub Colocar_Formula()
Hoja2.Columns("a:a").Clear
Select Case ActiveSheet.Name
Case Is = "Costos - Gastos"
Hoja2.Range("A1").FormulaLocal = "='" & Hoja2.Range("n1").Value
Case Is = "Ingresos"
Hoja2.Range("A1").FormulaLocal = "=" & Hoja2.Range("o1").Value
Case Is = "Seguros"
Hoja2.Range("A1").FormulaLocal = "=" & Hoja2.Range("p1").Value
Case Else
Hoja2.Range("A1").FormulaLocal = "=" & Hoja2.Range("q1").Value
End Select

Application.Volatile

End Sub

Sub Arrastre()
UltimaCosto = Hoja1.Range("b65536").End(xlUp).Row - 7

If UltimaCosto > 1 Then
Hoja2.Range("A1").AutoFill Destination:=Hoja2.Range("A1:a" & UltimaCosto), Type:=xlFillDefault
End If
End Sub

Sub Guardar_txt()
On Error Resume Next
Z = Hoja2.Range("A65536").End(xlUp).Row
Dim r As Range, c As Range
Dim sTemp As String

Open Ruta & Range("b5").Value For Output As #1
For Each r In Hoja2.Range("A1:A" & Z).Rows
sTemp = ""
For Each c In r.Cells
sTemp = sTemp & c.Text & Chr(9)
Next c
'Get rid of trailing tabs
While Right(sTemp, 1) = Chr(9)
sTemp = Left(sTemp, Len(sTemp) - 1)
Wend
Print #1, sTemp
Next r
Close #1

MsgBox "El archivo de nombre: " & Range("b5").Value & " fue creado con éxito" & Chr(13) & "Ubicalo en: " & Ruta, vbInformation, "PDT 3500 OPERACIONES CON TERCEROS (DAOT)"

End Sub

1 Respuesta

Respuesta
2

Estimado tienes pendiente valorar una respuesta.

Dante, agradecerte por el apoyo brindado.

Como te mencionaba la macro que encontré me arroja datos separados por "|" y yo quisiera que me separe por ";"  además el txt que se genere deberá de coger la información a partir de la  fila 8 (columnas a8 hasta m8) y luego a partir de la fila 9 (columnas b8 hasta la g9). Por favor espero puedas apoyarme; o rehacer la macro para obtener el resultado esperado.

Archivo Excel:

Resultado txt esperado(nombre de archivo =a5), es decir PLL00085820160701010001.txt:

000858;2016;07;01;01;0001;11;1794.9;665.18;0;0;0;0
01;00952517;00;1;0352;;100
01;00952517;00;1;0466;;1010.69
01;00952517;00;1;0467;;544.21
01;00952517;00;1;0488;;140
01;00952517;00;2;0006;Derrama Magisterial;19.75
01;00952517;00;2;0026;Subcafae;163.3
01;00952517;00;2;0113;AFP;131.59
01;00952517;00;2;0172;SUTEP;3.5
01;00952517;00;2;0418;Préstamo Derrama Magisterial;343.04
01;00952517;00;2;1631;COL.PROFESORES CAJAMARCA;4
01;00952517;00;9;9999;;1129.72

H o l  a:

Tienes pendiente valorar esta respuesta:

Como crear macro para importar columnas de excel a DBF

Sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas