导出数据到文件

Question

我有一种情况，我需要将一个标题行信息放入一个CSV文件中。

之后，我将需要追加3个不同列号的查询到这个文件。

目前有这样的逻辑，但TransferText线覆盖了我必须在它之前放置在文件中：

Dim fldr As String 

Dim dlg As Office.FileDialog 
Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 
With dlg 
    .AllowMultiSelect = False 
    .Title = "Select a Folder:" 
    .Filters.Clear 
    '.Filters.Add "CSV Files", "*.csv" 

    If .show = True Then 
     fldr = .SelectedItems(1) 
    End If 
End With 
GC dlg 

'TODO: Remove after Debugging is complete 
RaiseAlert "Folder chosen: " & fldr 
'----------------------------------------- 

Dim file As String 
file = fldr & "\Export_DelaGet_" & Format(Now(), "yyyy_mm_dd") & ".csv" 

'TODO: Remove after Debugging is complete 
RaiseAlert "File: " & file 
'----------------------------------------- 

'TODO: OpenFile and output the header line 
Open file For Output As #1 
Print #1, """SYS"",""Some Data""" & vbCrLf 
Close 1 

'Output Query/View Results to file 
DoCmd.TransferText acExportDelim, "MstPrc_Spec", "vwMasterPrices_Output", file, False 

它会更好，我只是遍历通过RecordSet中的查询还是我失去了TransferText中的一些内容？

Answer 1

除非其他人可以为我提供一个更好的方式来执行此操作，以下是我到目前为止的内容。

Dim fldr As String 

Dim dlg As Office.FileDialog 
Set dlg = Application.FileDialog(msoFileDialogFolderPicker) 
With dlg 
    .AllowMultiSelect = False 
    .Title = "Select a Folder:" 
    .Filters.Clear 
    '.Filters.Add "CSV Files", "*.csv" 

    If .show = True Then 
     fldr = .SelectedItems(1) 
    End If 
End With 
GC dlg 

'TODO: Remove after Debugging is complete 
' RaiseAlert "Folder chosen: " & fldr 
'----------------------------------------- 

Dim file As String 
file = fldr & "\Export_" & Format(Now(), "yyyy_mm_dd") & ".csv" 

'TODO: Remove after Debugging is complete 
' RaiseAlert "File: " & file 
'----------------------------------------- 

'TODO: OpenFile and output the header line 
Open file For Output As #1 
Print #1, """SYS"",""Some Data""" & vbCrLf 
Close 1 

Open file For Append As #2 
Dim rst As DAO.Recordset, str As String 

'Append MasterPrices 
Set rst = CurrentDb.OpenRecordset("vwMasterPrices_Output") 
If rst.RecordCount > 0 Then 
    Do While Not rst.EOF 
     str = """" & rst(0) & """,""" & rst(1) & """,""" & rst(2) & """,""" & rst(3) & """,""" & rst(4) & """," & Format(rst(5), "##0.00") 

     Print #2, str 

     'Move Next 
     rst.MoveNext 
    Loop 
End If 

'Append GroupPrice 
Set rst = CurrentDb.OpenRecordset("vwGroupPrice_Output") 
If rst.RecordCount > 0 Then 
    Do While Not rst.EOF 
     str = """" & rst(0) & """,""" & rst(1) & """,""" & rst(2) & """," & Format(rst(3), "##0.00") 

     Print #2, str 

     'Move Next 
     rst.MoveNext 
    Loop 
End If 

'Append GroupLocations 
Set rst = CurrentDb.OpenRecordset("vwGroupLocations_Output") 
If rst.RecordCount > 0 Then 
    Do While Not rst.EOF 
     str = """" & rst(0) & """,""" & rst(1) & """," & rst(2) 

     Print #2, str 
     'Move Next 
     rst.MoveNext 
    Loop 
End If 

GC rst 
Close 2 

不幸的是，TransferText方法执行File-Output而不是File-Append操作。因此，清除TransferText之前的文件中的所有内容并将其替换为该方法的输出。

是的，我不得不围绕字符串的CSV文本限定符。