2012-09-11 5 views
0

J'ai une situation dans laquelle je dois placer une ligne d'information dans un fichier CSV. Après quoi, j'aurai besoin d'ajouter 3 requêtes, de différents numéros de colonnes, à ce fichier.Exporter des données dans un fichier

ont actuellement cette logique, mais la ligne TransferText écrase ce que j'avais placé dans le fichier avant qu'il:

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 

Serait-il préférable pour moi juste itérer à travers la requête via RecordSet ou suis-je manque quelque chose dans TransferText?

Répondre

1

À moins que quelqu'un d'autre puisse me fournir une meilleure façon d'effectuer ceci, voici ce que j'ai jusqu'à présent.

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 

Malheureusement, la méthode TransferText effectue une File-Output et non une opération File-Append. Donc tout ce qui se trouve dans le fichier avant le TransferText est effacé et remplacé par la sortie de la méthode.

Oui, je devais avoir des qualificateurs de texte autour des chaînes pour le fichier CSV.

+0

Oui, j'ai construit mon propre VB6 Collector .... c'est une combinaison de 'Set = Nothing' (si objet) et si Objet RecordSet' .close'. Il faut un paramètre 'ParamArray', donc si j'ai un tas j'ai besoin de fermer (par exemple), je peux virgule les délimiter. – GoldBishop

Questions connexes