Alih-alih menggunakan makro untuk mengekspor tabel, Anda cukup membuat beberapa kode untuk membuka file, dan menambahkan data ke dalamnya.
Cara menggunakan
Cukup salin kode ke modul VBA di aplikasi Anda dan beri nama seperti ini:
' 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
Perhatikan bahwa ini tidak sempurna dan Anda mungkin harus menyesuaikan kode untuk mencerminkan bagaimana Anda ingin data diformat, tetapi defaultnya akan baik-baik saja dalam banyak kasus.