I stedet for at bruge en makro til at eksportere tabellen kan du simpelthen oprette en kode for at åbne filen og tilføje dataene til den.
Sådan bruges
Du skal blot kopiere koden til et VBA-modul i din applikation og kalde det sådan her:
' Export the Table "Orders" to "orders.csv", appending the data to the '
' existing file if there is one. '
ExportQueryToCSV "Orders", "C:\orders.csv", AppendToFile:=True
' Export the result of the query to "stock.csv" using tabs as delimiters '
' and no header or quotes around strings '
ExportQueryToCSV "SELECT * FROM Stock WHERE PartID=2", _
"C:\stock.csv", _
AppendToFile:=False, _
IncludeHeader:=False, _
Delimiter:=chr(9), _
QuoteString:=false
Kode
'----------------------------------------------------------------------------'
' Export the given query to the given CSV file. '
' '
' Options are: '
' - AppendToFile : to append the record to the file if it exists instead of '
' overwriting it (default is false) '
' - Delimiter : what separator to use (default is the coma) '
' - QuoteString : Whether string and memo fields should be quoted '
' (default yes) '
' - IncludeHeader: Whether a header with the field names should be the first '
' line (default no) '
' Some limitations and improvements: '
' - Memo containing line returns will break the CSV '
' - better formatting for numbers, dates, etc '
'----------------------------------------------------------------------------'
Public Sub ExportQueryToCSV(Query As String, _
FilePath As String, _
Optional AppendToFile As Boolean = False, _
Optional Delimiter As String = ",", _
Optional QuoteStrings As Boolean = True, _
Optional IncludeHeader As Boolean = True)
Dim db As DAO.Database
Dim rs As DAO.RecordSet
Set db = CurrentDb
Set rs = db.OpenRecordset(Query, dbOpenSnapshot)
If Not (rs Is Nothing) Then
Dim intFile As Integer
' Open the file, either as a new file or in append mode as required '
intFile = FreeFile()
If AppendToFile And (Len(Dir(FilePath, vbNormal)) > 0) Then
Open FilePath For Append As #intFile
Else
Open FilePath For Output As #intFile
End If
With rs
Dim fieldbound As Long, i As Long
Dim record As String
Dim field As DAO.field
fieldbound = .Fields.count - 1
' Print the header if required '
If IncludeHeader Then
Dim header As String
For i = 0 To fieldbound
header = header & .Fields(i).Name
If i < fieldbound Then
header = header & Delimiter
End If
Next i
Print #intFile, header
End If
' print each record'
Do While Not .EOF
record = ""
For i = 0 To fieldbound
Set field = .Fields(i)
If ((field.Type = dbText) Or (field.Type = dbMemo)) And QuoteStrings Then
record = record & """" & Nz(.Fields(i).value, "") & """"
Else
record = record & Nz(.Fields(i).value)
End If
If i < fieldbound Then
record = record & Delimiter
End If
Set field = Nothing
Next i
Print #intFile, record
.MoveNext
Loop
.Close
End With
Set rs = Nothing
Close #intFile
End If
Set rs = Nothing
Set db = Nothing
End Sub
Bemærk, at det ikke er perfekt, og du skal muligvis tilpasse koden, så den afspejler, hvordan du ønsker, at dataene skal formateres, men standardindstillingerne burde være i orden i de fleste tilfælde.