Forum

Forum (https://www.ms-office.gr/forum/)
-   Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)
-   -   ΑCCES 2019 VBA CODE query save to txt file (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/6468-acces-2019-visual-basic-applications-code-query-save-txt-file.html)

jimrenoir 16-04-24 00:15

ΑCCES 2019 VBA CODE query save to txt file
 
1 Συνημμένο(α)
Καλησπέρα.
Ανεβάζω ένα παράδειγμα μιας βάσης ,έχω φτιάξει μια λειτουργική μονάδα όπου προσπαθώ να σώζω το αποτέλεσμα ενός ερωτήματος (έχει ένα πεδίο μόνο) σε αρχείο τχτ με αλλο ονομα καθε φορά που θα του ορίζω χωρίς να σώζει στην πρώτη γραμμή το όνομα του ερωτήματος και χωρίς να έχει κενή γραμμή στο τέλος.
Δεν θέλω όμως να μου εμφανίζεται με αυτή την μορφή όταν το ανοίγω στο σημειωματάριο΄
-----------------------------------------
| Names |
------------------------------------------
| 15.02.2024,elena,nikosia,19,24 |
------------------------------------------
| 15.02.2024,crhis,leykosia,78,32 |
------------------------------------------
| 16.02.2024,Vag,Klim,109,01 |
------------------------------------------

(θέλω δηλαδή να έχω τις στήλες χωρίς την επικεφαλίδα και μόνο το κείμενο χωρίς τις γραμμές
αλλά να μου εμφανίζεται έτσι

15.02.2024,elena,nikosia,19,24
15.02.2024,crhis,leykosia,78,32
16.02.2024,Vag,Klim,109,01
Ευχαριστώ πολύ

pctechdr 16-04-24 13:51

1 Συνημμένο(α)
Δες αν σου κανει αυτο

jimrenoir 16-04-24 18:33

Ευχαριστώ
 
Καλησπέρα. Ευχαριστώ πολύ για την απάντηση σας.
Η λύση που μου προτείνατε ενώ κάνει Export το αρχείο και σε txt και σε csv έχει πρόβλημα στο μεν csv όταν θελήσεις να ανοίξεις το αρχείο με τον notepad εμφανίζει στην αρχή και στο τέλος κάθε γραμής την εντολή PRINT

"15.02.2024,elena,nikosia,19,24"
"15.02.2024,crhis,leykosia,78,32"
"16.02.2024,Vag,Klim,109,01"

Επίσης στο αρχείο που αποθηκεύεται σε μορφή txt στην πρώτη γραμμή είναι εντάξει στην δεύτερη εμφανίζει και την πρώτη και ην δεύτερη στην τριτη τι; προηγούμενες και αυτή μαζι.
15.02.2024,elena,nikosia,19,24
15.02.2024,elena,nikosia,19,24,15.02.2024,crhis,le ykosia,78,32
15.02.2024,elena,nikosia,19,24,15.02.2024,crhis,le ykosia,78,32,16.02.2024,Vag,Klim,109,01

Εάν έχεις χρόνο θα μπορούσε να διορθωθεί?.

pctechdr 16-04-24 20:15

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

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

jimrenoir 17-04-24 07:45

Ευχαριστίες
 
Καλημέρα. Ευχαριστώ πάρα πολύ είναι άψογο.

pctechdr 17-04-24 08:05

Καλημέρα. Να είσαι καλά.


Η ώρα είναι 02:07.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2