Как сохранить необходимые десятичные знаки при использовании команды DoCmd.TransferText для экспорта таблицы в файл .csv? - PullRequest
Новая
       10

Как сохранить необходимые десятичные знаки при использовании команды DoCmd.TransferText для экспорта таблицы в файл .csv?

4 голосов
/ 27 мая 2011

Я использую DoCmd.TransferText в MS-Access-2010 VBA для экспорта таблицы в файл .csv. Однако, когда я делаю это, результирующий файл .csv усекает информацию в таблице. Например, долгота -85,350223 становится -85,35. Как сделать так, чтобы полученный CSV-файл был разделен запятыми и содержал полную информацию из таблицы?

Если мне нужно создать спецификацию импорта / экспорта и ссылаться на нее в командной строке с помощью функции SpecificationName в DoCmd.TransferText (если я правильно интерпретировал эту функцию как инструмент форматирования), объясните, как сделать это.

Вот строка, которую я сейчас использую для экспорта файла в .csv:

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

Ответы [ 3 ]

4 голосов
/ 29 мая 2011

Я рекомендую вам использовать эту функцию, взятую из 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

Вы также можете добиться успеха, изменив поврежденные поля на текстовые поля или просто скопировав их в некоторые временные текстовые поля перед выполнением экспорта.

3 голосов
/ 16 мая 2012

Спасибо, @ HK1 за публикацию этого кода.Я сделал несколько модификаций:

  1. Исправлена ​​ошибка, на которую @Bryan указал
  2. Изменен экспорт, так что только данные поля Text и Memo окружаются квалификатором (числовые значения и значения датыобычно не обрабатываются как текст).
  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
0 голосов
/ 06 августа 2015

Отличный код всем.Работает очень хорошо и быстро.Я добавил одну строку, чтобы обработать ситуацию, когда переданное имя таблицы содержит пробел. 

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
...