将访问查询结果导出到csv

时间:2012-11-09 14:34:58

标签: vba ms-access

我有一个访问数据库,它操纵来自Magento电子商务商店的数据,重新格式化数据并(希望!)吐出一个CSV文件,然后可以导入到ebay Turbolister中,以便大量上传到eBay。

我已经创建了一个查询,它可以正确地将数据布局为Turbolister所需的格式。

我的问题很多(包括一些似乎与Access处理大字段内容有关的问题),但问题的关键在于我正在努力工作一个简单的脚本,它将查询结果导出为正确的格式化的CSV(包括在文本值中需要的双引号加倍,即如果值本身包含需要保留的引号)。

DoCmd.TransferText解决方案会抛出与字段大小相关的错误(“字段太小而无法接受您尝试添加的数据量”)因此没有任何好处。

有人在VBA中有一个很好的工作CSV导出例程,他们可以建议吗?

干杯

1 个答案:

答案 0 :(得分:2)

这是我以前习惯使用的旧函数,它允许您指定分隔符,它还会检查它输出的数据,如果它不能被评估为日期或数字等,那么它使用double引用:

Public Function ExportTextDelimited(strQueryName As String, strDelimiter As String)

Dim rs          As Recordset
Dim strHead     As String
Dim strData     As String
Dim inti        As Integer
Dim intFile     As Integer
Dim fso         As New FileSystemObject

On Error GoTo Handle_Err

    fso.CreateTextFile ("C:\Untitled.csv")

    Set rs = Currentdb.OpenRecordset(strQueryName)

    rs.MoveFirst

    intFile = FreeFile
    strHead = ""

    'Add the Headers
    For inti = 0 To rs.Fields.Count - 1
        If strHead = "" Then
            strHead = rs.Fields(inti).Name
        Else
            strHead = strHead & strDelimiter & rs.Fields(inti).Name
        End If
    Next

    Open "C:\Untitled.csv" For Output As #intFile

    Print #intFile, strHead

    strHead = ""

    'Add the Data
    While Not rs.EOF

        For inti = 0 To rs.Fields.Count - 1
            If strData = "" Then
                strData = IIf(IsNumeric(rs.Fields(inti).value), rs.Fields(inti).value, IIf(IsDate(rs.Fields(inti).value), rs.Fields(inti).value, """" & rs.Fields(inti).value & """"))
            Else
                strData = strData & strDelimiter & IIf(IsNumeric(rs.Fields(inti).value), rs.Fields(inti).value, IIf(IsDate(rs.Fields(inti).value), rs.Fields(inti).value, """" & rs.Fields(inti).value & """"))
            End If
        Next

        Print #intFile, strData

        strData = ""

        rs.MoveNext
    Wend

        Close #intFile

rs.Close
Set rs = Nothing

'Open the file for viewing
Application.FollowHyperlink "C:\Untitled.csv"   

Exit Function

Handle_Err:
MsgBox Err & " - " & Err.Description

End Function

我可能需要进行一些调整,因为我已经取出了一些仅与我的具体情况相关的位,但这可能是一个起点。