Excel-VBA-CSV-Datei Zitat Qualifier Export

Question

ich vba neu bin und Hilfe brauchen, wie ich dies aus nicht arbeiten können

Beim Versuch, einige spezifische Inhalte von einem der Arbeitsblätter in einer Excel-Arbeitsmappe in eine CSV-Datei zu speichern Datei, ich kann nicht das richtige Ausgabeformat bekommen. Dies ist kritisch, da einige Spalten Textqualifizierer benötigen und andere nicht und ich muss es richtig machen, da die Datei in eine Unternehmenslösung geht.

Ich habe 5 Spalten A-E, die Daten, die ich als csv exportieren müssen hält, Spalten A, C & E Texterkennungszeichen brauchen, aber B & D nicht.

Die CSV-Datei 2 Kopfzeilen hat, die haben noch keine "Qualifier

ich dies aber 2 Ausgaben 1) Spalten A, C & E in Anführungszeichen sein müssen arbeiten müssen, um zu bekommen versuche, mit B & D nicht in Anführungszeichen 2) Die Überschrift in Zeile 1 hat extra ,,,, auf das Ende, das ich entfernen möchte

Der Code, den ich verwende, ist unten, und ich habe ein Bild von einem angehängt Beispieldatei, um es zum Leben zu bringen.

Die Datei führt die folgenden 1) Wählt einen dynamischen Bereich von Zeilen in Spalten A-E 2) Speichert als einen spezifischen Namen mit Daten & Zeit enthalten es.

Sub SaveDynamicRangeAsCSVFile_IncTextDelimiters() 

'Turn off screen updating for performance and prevent dizziness 
    Application.ScreenUpdating = False 

'Set-up 
    Dim MyPath As String 
    Dim MyFileName As String 
    Dim WB1 As Workbook, WB2 As Workbook 
    Set WB1 = ActiveWorkbook 
    MyFileName = "ProdTabData-" & Format(Date, "yyyymmdd-") & Format(Time, "hhmmss") 
    FullPath = WB1.Path & "\" & MyFileName 

'Dynamic range identified 
    Application.ScreenUpdating = False 
    Range("A5:E" & Cells(Rows.Count, 1).End(xlUp).Row).Copy 
    Set WB2 = Application.Workbooks.Add(1) 
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues 
    Application.DisplayAlerts = False 

'save file 
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv" 
    With WB2 
     .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False 
     .Close False 
    End With 
    Application.DisplayAlerts = False 

'Turn on screen updating 
     Application.ScreenUpdating = True 

End Sub 

Die Ausgabe, die es mir gibt, ist:

Export Dateiname ,,,,

Column1, Column2, Column3, Column4, Column5

Name 1, Gruppe 1, Beschreibung 1, 1,0

Name 2, Gruppe 2, Beschreibung 2,1,0

Name 3, Gruppe 3, Descripti auf 3,1,0

Name 4, Gruppe 4, Beschreibung 4,1,0

name 5, Group5, Beschreibung 5,1,0

Name 6, Gruppe6, Description 6,1, 0

Name 7, Group7, Beschreibung 7,1,0

ich es brauchen:

Export Dateiname

Column1, Column2, Column3, Column4, Column5

"Name 1", Gruppe1, "Beschreibung 1", 1 "0"

"Name 2", Group2, "Beschreibung 2", 1“ 0"

"name 3", Group3, "Beschreibung 3", 1, "0"

"name 4", Gruppe 4, "Beschreibung 4", 1, "0"

„name 5 ", Gruppe5," Beschreibung 5 ", 1," 0 "

" name 6 ", Grou p6, "Beschreibung 6", 1 "0"

"name 7", Group7, "Beschreibung 7", 1 "0"

Ich halte Looping um verschiedene Lösungen, so einige kompetente Unterstützung benötigen bitte .

Alle Vorschläge willkommen wie verzweifelt Dank

Excel file image

Answer 1

Ich denke, gehen sie wie folgt

Sub SaveDynamicRangeAsCSVFile_IncTextDelimiters() 
    Dim rngDB As Range 
'Turn off screen updating for performance and prevent dizziness 
    Application.ScreenUpdating = False 

'Set-up 
    Dim MyPath As String 
    Dim MyFileName As String 
    Dim WB1 As Workbook, WB2 As Workbook 
    Set WB1 = ActiveWorkbook 
    MyFileName = "ProdTabData-" & Format(Date, "yyyymmdd-") & Format(Time, "hhmmss") 
    FullPath = WB1.Path & "\" & MyFileName 

'Dynamic range identified 
    Application.ScreenUpdating = False 
    Set rngDB = Range("A5:E" & Cells(Rows.Count, 1).End(xlUp).Row) 
    Application.DisplayAlerts = False 

'save file 
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv" 
    Application.DisplayAlerts = False 
    TransToCSV MyFileName, rngDB 
'Turn on screen updating 
     Application.ScreenUpdating = True 

End Sub 
Sub TransToCSV(myfile As String, rng As Range) 

    Dim vDB, vR() As String, vTxt() 
    Dim i As Long, n As Long, j As Integer 
    Dim objStream 
    Dim strTxt As String 

    Set objStream = CreateObject("ADODB.Stream") 
    vDB = rng 
    For i = 1 To UBound(vDB, 1) 
     n = n + 1 
     ReDim vR(1 To UBound(vDB, 2)) 
     For j = 1 To UBound(vDB, 2) 
      Select Case j 
      Case 1, 3, 5 
       If i = 2 Then 
        vR(j) = vDB(i, j) 
       Else 
        vR(j) = Chr(34) & vDB(i, j) & Chr(34) 
       End If 
      Case Else 
       vR(j) = vDB(i, j) 
      End Select 
     Next j 
     ReDim Preserve vTxt(1 To n) 
     If i = 1 Then 
      vTxt(n) = vDB(1, 1) 
     Else 
      vTxt(n) = Join(vR, ",") 
     End If 
    Next i 
    strTxt = Join(vTxt, vbCrLf) 
    With objStream 
     '.Charset = "utf-8" 
     .Open 
     .WriteText strTxt 
     .SaveToFile myfile, 2 
     .Close 
    End With 
    Set objStream = Nothing 

End Sub