Excel VBA中導出CSV文件的報價預選賽

Question

我是新來的VBA，需要一些幫助，我不能工作了這一點

當試圖從工作表中的一個Excel工作簿中的一些具體內容保存到一個CSV文件，我無法獲得正確的輸出格式。這是至關重要的，因爲某些列需要文本限定符，而其他列則不需要，因爲文件將進入企業解決方案，所以我必須把它做好。

我有5列A-E，它包含我需要導出爲csv的數據，列A，C & E需要文本限定符，但B & D不要。

CSV文件中有2個行，其中沒有任何「預選賽

我試圖得到這個工作，但是有2個問題 1）列A，C & E需求加引號，與B & D不在報價 2）行1中的標頭有額外的,,,,我想要刪除的末端

我使用的代碼是在下面，我附上了一個示例文件使其生效

該文件具有以下功能 1）選擇列內的行的動態範圍A-E 2）保存爲具有數據的特定名稱&時間包括它。

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 

它給我的輸出是：

導出文件名,,,,

列1，列2，欄3，Column4，Column5

名稱1，組1，說明1， 1,0

名稱2，組2，說明2,1,0

名稱3，組3，Descripti上3,1,0

名稱4，組4，說明4,1,0

名稱5，組5，說明5,1,0

名6，6組，說明6,1， 0

名7，7組，說明7,1,0

我需要它是：

導出文件名

列1，列2，欄3，Column4，Column5

「名稱1」，組1， 「描述1」，1， 「0」

「姓名2」，第2組， 「描述2」，1「， 0"

「名稱3」，第3組， 「描述3」，1， 「0」

「名稱4」，組4， 「描述4」，1， 「0」

「名5「，Group5，」Description 5「，1，」0「

」name 6「，Grou P6， 「說明」，1， 「0」

「名7」，7組， ​​「說明7」，1， 「0」

我一直循環各地不同的解決方案，所以需要一些專家的指導，請。

所有的建議表示歡迎爲越來越絕望 感謝

Excel file image

Answer 1

我覺得做這樣的

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