Access - Exportar consulta de Access a Excel con formato .csv

Hola, saludos, tengo un código que construye una tabla a partir de los datos de una consulta, al finalizar la construcción de la tabla la guarda en formato .xls poniéndole nombre determinado y otros datos de una tabla. Ahora necesito que se exporte a Excel igual pero a formato .csv separado por punto y coma y que no le ponga nombre a la columna. No se si me hago entender, el código es:

Hola, saludos, tengo un código que construye una tabla a partir de los datos de una consulta, al finalizar la construcción de la tabla la guarda en formato .xls poniéndole nombre determinado y otros datos de una tabla. Ahora necesito que se exporte a Excel igual pero a formato .csv separado por punto y coma y que no le ponga nombre a la columna. No se si me hago entender, el código es:

Private Sub cmdExpDAOC_Click()
Dim rstNombrePrograma As DAO.Recordset, _
rstTituloTema As DAO.Recordset, _
qdf As DAO.QueryDef, _
strSQL As String, _
strHoja As String, _
strArchivo As String, _
strTitulo As String, _
Campo As DAO.Field, _
lngColumna As Long, _
i As Long, _
xls As Object

Const xlWBATWorksheet = -4167
Const xlAutomatic = -4105
Const xlSolid = 1
Const xlThemeColorDark1 = 1
Const xlToRight = -4161
Const xlNormal = -4143

On Error GoTo cmdExpDAOC_Click_TratamientoErrores

strSQL = "SELECT NombrePrograma"
strSQL = strSQL & " FROM ProgramasEmitidosDerAut"
strSQL = strSQL & " GROUP BY NombrePrograma"

Set xls = CreateObject("Excel.Application")
xls.Visible = True

xls.Workbooks.Add xlWBATWorksheet
strHoja = xls.ActiveSheet.Name

Set rstNombrePrograma = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

If Not (rstNombrePrograma.EOF And rstNombrePrograma.BOF) Then
Do
strSQL = "SELECT TituloTema, NombreAutor, NombreInterprete, Sonatas, Fecha, Calculo, Local, Plantilla "
strSQL = strSQL & "FROM ProgramasEmitidosDerAut"
strSQL = strSQL & " WHERE NombrePrograma = Parametro1"
Set qdf = CurrentDb.CreateQueryDef("", strSQL)

qdf.Parameters("Parametro1") = rstNombrePrograma!NombrePrograma
Set rstTituloTema = qdf.OpenRecordset
xls.ActiveWorkbook.Sheets.Add Before:=xls.Worksheets(xls.Worksheets.Count)
xls.ActiveSheet.Name = rstNombrePrograma!NombrePrograma

With xls
lngColumna = 1
For Each Campo In rstTituloTema.Fields
strTitulo = ""
For i = 1 To Len(Campo.Name)
strTitulo = strTitulo & Mid(Campo.Name, i, 1)
If i < Len(Campo.Name) Then
If EsMayuscula(Mid(Campo.Name, i + 1, 1)) Then strTitulo = strTitulo & " "
End If
Next i
.ActiveSheet.Cells(1, lngColumna) = strTitulo
lngColumna = lngColumna + 1
Next Campo
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Font.Bold = True
With .Selection.Interior
.Pattern = xlSolid
.ColorIndex = 15
End With
End With

If Not (rstTituloTema.EOF And rstTituloTema.BOF) Then
xls.ActiveSheet.Cells(2, 1).CopyFromRecordset rstTituloTema
End If
xls.Columns("A:G").EntireColumn.AutoFit
rstNombrePrograma.MoveNext
Loop Until rstNombrePrograma.EOF
End If

xls.Application.DisplayAlerts = False
xls.ActiveWorkbook.Worksheets(strHoja).Delete

strArchivo = "D:\SG RADIO\INFORMACIONES\ACDAM\" & DLookup("Emisora", "01TNomencladorEmisora") & " Derecho Autor Obras Completas.xls"
If Not Nz(strArchivo, "") = "" Then
xls.ActiveWorkbook.SaveAs FileName:=strArchivo, FileFormat:=xlNormal
Else
xls.ActiveWorkbook.Saved = True
End If
xls.Application.DisplayAlerts = True

cmdExpDAOC_Click_Salir:
On Error Resume Next
xls.Quit
Set xls = Nothing
Set qdf = Nothing
CierraRecordsetDAO rstNombrePrograma
CierraRecordsetDAO rstTituloTema
On Error GoTo 0
Exit Sub

cmdExpDAOC_Click_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: cmdExpDAOC_Click de Documento VBA: Form_frmFrmIniCaptacion (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume cmdExpDAOC_Click_Salir
Resume Next
End Sub

Hola,

Mírate este link:

https://www.lawebdelprogramador.com/foros/Access/1033952-Exportar-una-Tabla-de-access-a-Format-CSV.html

Hola Joan, bue día, hice los cambios en el código y me funciona bien con la excepción de que lleva los datos a columnas diferentes y realmente lo necesito separado por comillas y todo en una sola columna, pudieras ayudarme?

los cambios

Private Sub cmdExpDAOC_Click()
Dim rst As DAO.Recordset
Dim Archivo As String
Archivo = "D:\SG RADIO\INFORMACIONES\ACDAM\" & DLookup("Emisora", "01TNomencladorEmisora") & " Derecho Autor Obras Incidentales.csv"
Set rst = CurrentDb.OpenRecordset("ProgramasEmitidosDerAut")
Open Archivo For Output As #1
'Write #1, "TituloTema", "NombreAutor", "NombreInterprete", "Sonatas", "Calculo base", "EmisoraR", "Programa"
While Not rst.EOF
Write #1, rst![TituloTema], ";"; rst![NombreAutor], ";"; rst![NombreInterprete], ";"; rst![Sonatas], ";"; rst![Calculo base], ";"; rst![EmisoraR], ";"; rst![Programa]
rst.MoveNext
Wend
Close #1
rst.Close: Set rst = Nothing
MsgBox "El archivo " & Archivo & " ha sido creado con éxito.", vbInformation, "Creación de Archivo CSV"
End Sub

amigo, ya está resuelto, gracias una vez más por todo

De nada

Hola Joan, nuevamente Carlos, mira la exportación al libro de Excel.csv se hace bien, cuando se probó a hacer la importación en el otro programa da un error, la cuestión es que el divide las columnas con punto y coma, pero al inicio y el final de la línea le coloca comillas, se podrá resolver esa situación? Necesito tu ayuda.
Te envío imágines

Esto el excel



Visto en Notepad



Saludos amigo

No te lo está llevando a columna diferentes, te lo está poniendo todo en la columna A, lo que pasa que el texto es largo y te aparece así, si haces más ancha la columna o ajustas el texto verás que todo está en la A. La verdad es que nunca he usado la exportación a .csv, así que no sé como ayudarte. Lo siento.

A ver si alguien te puede ayudar o abres otro hilo con este problema.

Un saludo,

gracias amigo