4

我正在使用 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"

4

3 回答 3

4

我建议您使用从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, Len(strDelimiter) + 2 ) 
         Print # intOpenFile, 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

您也可以通过将有问题的字段更改为文本字段，或者在导出之前将它们复制到一些临时文本字段中来获得成功。

于 2011-05-29T02:47:48.943 回答
3

感谢@HK1 发布此代码。我做了一些修改：

  1. 修复了@Bryan 指出的错误
  2. 更改了导出，以便只有文本和备注字段数据被限定符包围（数字和日期值通常不被视为文本）。
  3. 将限定符参数更改为字符串，以便可以使用自定义文本限定符（例如单引号而不是双引号）
  4. 由于函数没有返回任何值，因此将过程更改为 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, strFile, 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, strQualifier & strQualifier, "")
        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
于 2012-05-16T18:44:14.880 回答
0

每个人都很棒的代码。它工作得很好而且很快。我添加了一行，用于处理传入的表名包含空格的情况。

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, strFile, Chr$(34), ",", 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, 1) = "[", 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, strQualifier & strQualifier, "")
    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
于 2015-08-06T01:45:50.207 回答