问题描述
|
我在MS-Access-2010 VBA中使用DoCmd.TransferText将表导出到.csv文件。但是,当我这样做时,生成的.csv文件会截断表中的信息。例如,经度-85.350223变为-85.35。如何在生成的.csv文件仍用逗号分隔并保留表格中的全部信息的位置进行设置?
如果我需要创建导入/导出规范并使用DoCmd.TransferText的SpecificationName功能在命令行中引用它(假设我已正确将此功能解释为格式工具),请说明如何执行此操作。
这是我当前用于将文件导出到.csv的行:
DoCmd.TransferText acExportDelim,
\“ AllMetersAvgRSSI \”,
CurrentProject.Path和
\“ \\ AllMetersAvgRSSI.csv \”
解决方法
我建议您使用从eraserve获得的此功能:
这是您使用/调用它的方式:
Call ExportToCSV(\"AllMetersAvgRSSI\",_
CurrentProject.Path & \"\\AllMetersAvgRssi.csv\")
这是函数:
Public Function ExportToCSV(TableName As String,_
strFile As String,_
Optional tfQualifier As Boolean,_
Optional strDelimiter As String = \",\",_
Optional FieldNames As Boolean ) As Byte
\'References: Microsoft Access 11.0 Object Library,Microsoft DAO 3.6 Object Library
\'Set references by Clicking Tools and Then References in the Code View window
\'
\' Exports a table to a text file.
\' Accepts
\' Tablename: Name of the Target Table
\' strFile: Path and Filename to Export the table to
\' tfQualifier: True or False
\'strDelimiter: String Value defaults to comma:,\' FieldNames: True or False
\'
\'USAGE: ExportToCSV TableName,strFile,True,True
On Error GoTo errhandler
Dim intOpenFile As Integer,x As Integer
Dim strSQL As String,strCSV As String,strPrint As String,strQualifier As String
\'Close any open files,not that we expect any
Reset
\'Grab Next Free File Number
intOpenFile = FreeFile
\'OPen our file for work
Open strFile For Output Access Write As # intOpenFile
\'Write the contents of the table to the file
\'Open the source
strSQL = \"SELECT * FROM \" & TableName & \" As \" & TableName
\'set the qualifer
strQualifier = Chr( 34 )
With CurrentDb.OpenRecordset(strSQL,dbOpenSnapshot)
\'Check if we need Field Names
If FieldNames = True Then
For x = 0 To .Fields.Count - 1
If tfQualifier = True Then
\'Write the Field Names as needed
\'The Qualifier is strQualifier or Quote
strCSV = strCSV & strQualifier & strDelimiter & strQualifier & _
.Fields(x).Name
\'Add last strQualifier
If x = .Fields.Count - 1 Then
strCSV = strCSV & strQualifier
End If
Else
\'Write the Field Names as needed
\'No Qualifier
strCSV = strCSV & strDelimiter & .Fields(x).Name
End If
Next x
\'Write to File
strPrint = Mid(strCSV,Len(strDelimiter) + 2 )
Print # intOpenFile,strPrint
End If
\'Write the CSV
Do Until .EOF
strCSV = \"\"
For x = 0 To .Fields.Count - 1
\'Check for Qualifier
If tfQualifier = True Then
\'The Qualifier is strQualifier or Quote
strCSV = strCSV & strQualifier & strDelimiter & strQualifier & _
Nz(.Fields(x),vbNullString)
\'Add last strQualifier
If x = .Fields.Count - 1 Then
strCSV = strCSV & strQualifier
End If
Else
\'No Qualifier
strCSV = strCSV & strDelimiter & Nz(.Fields(x),vbNullString)
End If
Next x
\'Eliminate Back to back strQualifiers or Qualifiers if changed
strCSV = Replace(strCSV,strQualifier & strQualifier,\"\" )
strPrint = Mid(strCSV,strPrint
.MoveNext
Loop
End With
ExitHere:
\'Close the file
Close # intOpenFile
Exit Function
errhandler:
With Err
MsgBox \"Error \" & .Number & vbCrLf & .Description,_
vbOKOnly Or vbCritical,\"ExportToCSV\"
End With
Resume ExitHere
End Function
通过将有问题的字段更改为文本字段,或在执行导出操作之前将它们简单地复制到某些临时文本字段中,也可能会获得成功。
, 谢谢@ HK1发布此代码。我做了一些修改:
修复了@Bryan指出的错误
更改了导出,以便仅“文本”和“备注”字段数据被限定符包围(通常不将数字和日期值视为文本)。
将限定符参数更改为字符串,以便可以使用自定义文本限定符(例如,单引号而不是双引号)
由于函数未返回任何值,因此将过程更改为Sub。
注意:这可用于导出表或查询(选择或交叉表)。
调用方式(假设文本定界符使用双引号):
Call ExportToCSV(\"AllMetersAvgRSSI\",_
CurrentProject.Path & \"\\AllMetersAvgRssi.csv\",Chr$(34))
这是功能:
Public Sub ExportToCSV(TableName As String,_
strFile As String,_
Optional strQualifier As String = vbNullString,_
Optional strDelimiter As String = \",_
Optional FieldNames As Boolean = False)
\'References: Microsoft Access 11.0 Object Library,Microsoft DAO 3.6 Object Library
\'Set references by Clicking Tools and Then References in the Code View window
\'
\' Exports a table to a text file.
\' Accepts
\' Tablename: Name of the Target Table or Query
\' strFile: Path and Filename to Export the table to
\' strQualifier: specifies text qualifier (typically a double-quote)
\' strDelimiter: String Value defaults to comma:,\' FieldNames: True or False
\'
\'USAGE: ExportToCSV TableName,Chr$(34),True
On Error GoTo errhandler
Dim intOpenFile As Integer
Dim strSQL As String,strCSV As String
Dim fld As DAO.Field
\'Close any open files,not that we expect any
Reset
\'Grab Next Free File Number
intOpenFile = FreeFile
\'Open our file for work
Open strFile For Output Access Write As #intOpenFile
\'Write the contents of the table to the file
\'Open the source
strSQL = \"SELECT * FROM \" & TableName
With CurrentDb.OpenRecordset(strSQL,dbOpenSnapshot)
\'Check if we need Field Names
If FieldNames Then
For Each fld In .Fields
strCSV = strCSV & strDelimiter & strQualifier & fld.Name & strQualifier
Next fld
\' remove leading delimiter
strCSV = Mid$(strCSV,Len(strDelimiter) + 1)
\'Write to File
Print #intOpenFile,strCSV
End If
\'Write records to the CSV
Do Until .EOF
strCSV = \"\"
For Each fld In .Fields
If fld.Type = dbText Or fld.Type = dbMemo Then
strCSV = strCSV & strDelimiter & strQualifier & fld.Value & strQualifier
Else
strCSV = strCSV & strDelimiter & fld.Value
End If
Next fld
\' remove leading delimiter
strCSV = Mid$(strCSV,Len(strDelimiter) + 1)
\'Eliminate Back to back strQualifiers
If Len(strQualifier) > 0 Then
strCSV = Replace(strCSV,\"\")
End If
\'Write to File
Print #intOpenFile,strCSV
.MoveNext
Loop
.Close
End With
ExitHere:
\'Close the file
Close #intOpenFile
Exit Sub
errhandler:
With Err
MsgBox \"Error \" & .Number & vbCrLf & .Description,_
vbOKOnly Or vbCritical,\"ExportToCSV\"
End With
Resume ExitHere
End Sub
, 伟大的代码大家。它运作良好且快速。我添加了一行,以处理传入的表名包含空格的情况。
Tablename = IIf(Left(Tablename,1) = \"[\",Tablename,\"[\" & Tablename & \"]\")
整个过程的我的版本(有一个更改):
Public Sub ExportToCSV(Tablename As String,_
strFile As String,_
Optional strQualifier As String = vbNullString,_
Optional strDelimiter As String = \",_
Optional FieldNames As Boolean = False)
\'References: Microsoft Access 11.0 Object Library,Microsoft DAO 3.6 Object Library
\'Set references by Clicking Tools and Then References in the Code View window
\'
\' Exports a table to a text file.
\' Accepts
\' Tablename: Name of the Target Table or Query
\' strFile: Path and Filename to Export the table to
\' strQualifier: specifies text qualifier (typically a double-quote)
\' strDelimiter: String Value defaults to comma:,\' FieldNames: True or False
\'
\'USAGE: ExportToCSV TableName,True
On Error GoTo errhandler
Dim intOpenFile As Integer
Dim strSQL As String,strCSV As String
Dim fld As DAO.Field
Tablename = IIf(Left(Tablename,\"[\" & Tablename & \"]\")
\'Close any open files,not that we expect any
Reset
\'Grab Next Free File Number
intOpenFile = FreeFile
\'Open our file for work
Open strFile For Output Access Write As #intOpenFile
\'Write the contents of the table to the file
\'Open the source
strSQL = \"SELECT * FROM \" & Tablename
With CurrentDb.OpenRecordset(strSQL,dbOpenSnapshot)
\'Check if we need Field Names
If FieldNames Then
For Each fld In .Fields
strCSV = strCSV & strDelimiter & strQualifier & fld.Name & strQualifier
Next fld
\' remove leading delimiter
strCSV = Mid$(strCSV,Len(strDelimiter) + 1)
\'Write to File
Print #intOpenFile,strCSV
End If
\'Write records to the CSV
Do Until .EOF
strCSV = \"\"
For Each fld In .Fields
If fld.Type = dbText Or fld.Type = dbMemo Then
strCSV = strCSV & strDelimiter & strQualifier & fld.Value & strQualifier
Else
strCSV = strCSV & strDelimiter & fld.Value
End If
Next fld
\' remove leading delimiter
strCSV = Mid$(strCSV,Len(strDelimiter) + 1)
\'Eliminate Back to back strQualifiers
If Len(strQualifier) > 0 Then
strCSV = Replace(strCSV,\"\")
End If
\'Write to File
Print #intOpenFile,strCSV
.MoveNext
Loop
.Close
End With
ExitHere:
\'Close the file
Close #intOpenFile
Exit Sub
errhandler:
With Err
MsgBox \"Error \" & .Number & vbCrLf & .Description,_
vbOKOnly Or vbCritical,\"ExportToCSV\"
End With
Resume ExitHere
End Sub