[發問] 求EXCEL 轉 CSV 檔案(UTF-8格式)

PKKO

有時需要這種資料,手動會很擾人
我錄製了巨集
將EXCEL轉為CSV檔案+UFT-8格式
但實際上卻不是UFT-8

有大大願意分享一下如何可以辦到嗎?
以下是小弟錯誤的CODE

1. With ActiveWorkbook.WebOptions
   
2.         .RelyOnCSS = True
   
3.         .OrganizeInFolder = True
   
4.         .UseLongFileNames = True
   
5.         .DownloadComponents = False
   
6.         .RelyOnVML = False
   
7.         .AllowPNG = True
   
8.         .ScreenSize = msoScreenSize1024x768
   
9.         .PixelsPerInch = 96
   
10.         .Encoding = msoEncodingUTF8
    
11.     End With
    
12.     With Application.DefaultWebOptions
    
13.         .SaveHiddenData = True
    
14.         .LoadPictures = True
    
15.         .UpdateLinksOnSave = True
    
16.         .CheckIfOfficeIsHTMLEditor = True
    
17.         .AlwaysSaveInDefaultEncoding = False
    
18.         .SaveNewWebPagesAsWebArchives = True
    
19.     End With
    
20.     ActiveWorkbook.SaveAs Filename:="C:\Users\user\Documents\test2.csv", _
    
21.         FileFormat:=xlCSV, CreateBackup:=False

複製代碼

也有上網查過,下面這個也不是UTF-8的樣子

1. Sub saveUnicodeCSV()
   
2. Set oAdoS = CreateObject("ADODB.Stream")
   
3. 
   
4.     oAdoS.Charset = "UTF-8"
   
5.     oAdoS.Mode = 3
   
6.     oAdoS.Type = 2
   
7.     oAdoS.Open
   
8. 
   
9. lRow = 1
   
10. lCol = 1
    
11. Do Until Sheets(1).Cells(lRow, lCol).Value = ""
    
12.   oAdoS.WriteText (Sheets(1).Cells(lRow, lCol).Text)
    
13.   lCol = lCol + 1
    
14.   Do Until Sheets(1).Cells(lRow, lCol).Value = ""
    
15.    oAdoS.WriteText ("|" & Sheets(1).Cells(lRow, lCol).Text)
    
16.    lCol = lCol + 1
    
17.   Loop
    
18.   oAdoS.WriteText (vbCrLf)
    
19.   lCol = 1
    
20.   lRow = lRow + 1
    
21. Loop
    
22. 
    
23. oAdoS.SaveToFile "test.csv", 2
    
24. oAdoS.Close
    
25. Set oAdoS = Nothing
    
26. End Sub

複製代碼

PKKO

更正,以下方式可以成功轉為UTF8+CSV

1. Sub saveUnicodeCSV()
   
2. Set oAdoS = CreateObject("ADODB.Stream")
   
3. 
   
4.     oAdoS.Charset = "UTF-8"
   
5.     oAdoS.Mode = 3
   
6.     oAdoS.Type = 2
   
7.     oAdoS.Open
   
8. 
   
9. lRow = 1
   
10. lCol = 1
    
11. Do Until Sheets(1).Cells(lRow, lCol).Value = ""
    
12.   oAdoS.WriteText (Sheets(1).Cells(lRow, lCol).Text)
    
13.   lCol = lCol + 1
    
14.   Do Until Sheets(1).Cells(lRow, lCol).Value = ""
    
15.    oAdoS.WriteText ("," & Sheets(1).Cells(lRow, lCol).Text)
    
16.    lCol = lCol + 1
    
17.   Loop
    
18.   oAdoS.WriteText (vbCrLf)
    
19.   lCol = 1
    
20.   lRow = lRow + 1
    
21. Loop
    
22. 
    
23. oAdoS.SaveToFile "c:\test.csv", 2
    
24. oAdoS.Close
    
25. Set oAdoS = Nothing
    
26. End Sub

複製代碼