How do I keep the necessary decimal places when us

问题:

I am using the DoCmd.TransferText in MS-Access-2010 VBA to export a table to a .csv file. However when I do this the resulting .csv file truncates the information in the table. For example the longitude -85.350223 becomes -85.35. How do I make it where the resulting .csv file is still comma delimited and keeps the full information from the table?

If I need to create an Import/Export specification and reference it in the command line using the SpecificationName feature of DoCmd.TransferText (assuming I have correctly interpreted this feature as a formatting tool) please explain how to do that.

Here is the line I am currently using to export the file to .csv:

DoCmd.TransferText acExportDelim, , "AllMetersAvgRSSI", CurrentProject.Path & "\AllMetersAvgRSSI.csv"

回答1:

I recommend you use this function taken from eraserve:

Here's how you use/call it:

Call ExportToCSV("AllMetersAvgRSSI", _
                  CurrentProject.Path & "\AllMetersAvgRssi.csv")  

And here's the function:

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 

You may also have success by changing the offending fields to text fields, or simply copying them into some temporary text fields before you do the export.

回答2:

Thanks, @HK1 for posting this code. I made a few modifications:

1. Fixed the bug that @Bryan pointed out
2. Changed the export so that only Text and Memo field data get surrounded by the qualifier (numeric and date values are generally not treated as text).
3. Changed the qualifier parameter to a string so that a custom text qualifier can be used (e.g. single quote instead of double-quote)
4. Changed the procedure to a Sub since the Function didn't return any value.

Note: This can be used to export tables or queries (select or crosstab).

Here's how you call it (assuming double-quotes for the text delimiter):

Call ExportToCSV("AllMetersAvgRSSI", _
                  CurrentProject.Path & "\AllMetersAvgRssi.csv", Chr$(34)) 

Here's the function:

    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

回答3:

Great code everyone. It works very well and fast. I added one line, to handle the situation where the table name passed in contains a space.

Tablename = IIf(Left(Tablename, 1) = "[", Tablename, "[" & Tablename & "]")

My version of the entire procedure (with that one change):

   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