[pctechdr]

Public Function ExportQueryToExcelAndText(queryName As String, fileNamePrefix As String, outputPath As String) As Boolean
On Error GoTo ErrorHandler

' Export to Excel with field names
DoCmd.OutputTo acOutputQuery, queryName, acFormatXLSX, outputPath & fileNamePrefix & "_with_fields.xlsx", False

' Open the exported Excel file
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False ' Hide Excel application
Dim wb As Object
Set wb = excelApp.Workbooks.Open(outputPath & fileNamePrefix & "_with_fields.xlsx")

' Delete column headers
wb.Sheets(1).Rows(1).Delete

' Save Excel file as CSV without double quotes
wb.SaveAs FileName:=outputPath & fileNamePrefix & ".csv", FileFormat:=6, Local:=True ' xlCSV format code

' Close Excel
wb.Close False
excelApp.Quit

' Release objects
Set wb = Nothing
Set excelApp = Nothing

' Convert CSV to text file
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim csvFile As Object
Dim txtFile As Object

' Open CSV file
Set csvFile = fso.OpenTextFile(outputPath & fileNamePrefix & ".csv", 1) ' 1 for reading

' Create text file
Set txtFile = fso.CreateTextFile(outputPath & fileNamePrefix & ".txt", True)

' Write data to the text file
Do Until csvFile.AtEndOfStream
txtFile.WriteLine csvFile.ReadLine
Loop

' Close files
txtFile.Close
csvFile.Close

' Delete CSV file
fso.DeleteFile outputPath & fileNamePrefix & ".csv"

' Delete XLSX file
fso.DeleteFile outputPath & fileNamePrefix & "_with_fields.xlsx"

ExportQueryToExcelAndText = True
Exit Function

ErrorHandler:
ExportQueryToExcelAndText = False
MsgBox "Error exporting query: " & Err.Description, vbExclamation
End Function

Αντικατέστησε αυτό