使用DoCmd.TransferText命令将表导出到.csv时，如何保留必要的小数位？

| 我在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 \”     
2020-01-14 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
    通过将有问题的字段更改为文本字段，或在执行导出操作之前将它们简单地复制到某些临时文本字段中，也可能会获得成功。     
    2020-01-14 0 0
    分享

    扦帽次杏

            谢谢@ 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, 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
        
    2020-01-14 0 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
        
    2020-01-14 0 0
    分享
    为什么被折叠? 0 个回复被折叠

    要回复问题请先登录或注册

    或代码 OrCode.com 备案号：粤ICP备15020848号-1
    Escape time: 0.034749031066895