Вместо того, чтобы использовать макрос для экспорта таблицы, вы можете просто создать некоторый код для открытия файла и добавить к нему данные.
Как использовать
Просто скопируйте код в модуль VBA в вашем приложении и назовите его так:
' 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
код
'----------------------------------------------------------------------------'
' 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
Обратите внимание, что он не идеален, и вам, возможно, придется адаптировать код, чтобы отразить, как вы хотите, чтобы данные форматировались, но в большинстве случаев значения по умолчанию должны быть хорошими.