Board logo

標題: [發問] 求EXCEL 轉 CSV 檔案(UTF-8格式) [打印本頁]

作者: PKKO    時間: 2016-9-27 16:38     標題: 求EXCEL 轉 CSV 檔案(UTF-8格式)

本帖最後由 PKKO 於 2016-9-27 16:40 編輯

有時需要這種資料,手動會很擾人
我錄製了巨集
將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.     oAdoS.Charset = "UTF-8"
  4.     oAdoS.Mode = 3
  5.     oAdoS.Type = 2
  6.     oAdoS.Open

  7. lRow = 1
  8. lCol = 1
  9. Do Until Sheets(1).Cells(lRow, lCol).Value = ""
  10.   oAdoS.WriteText (Sheets(1).Cells(lRow, lCol).Text)
  11.   lCol = lCol + 1
  12.   Do Until Sheets(1).Cells(lRow, lCol).Value = ""
  13.    oAdoS.WriteText ("|" & Sheets(1).Cells(lRow, lCol).Text)
  14.    lCol = lCol + 1
  15.   Loop
  16.   oAdoS.WriteText (vbCrLf)
  17.   lCol = 1
  18.   lRow = lRow + 1
  19. Loop

  20. oAdoS.SaveToFile "test.csv", 2
  21. oAdoS.Close
  22. Set oAdoS = Nothing
  23. End Sub
複製代碼

作者: PKKO    時間: 2016-9-27 19:05

更正,以下方式可以成功轉為UTF8+CSV
  1. Sub saveUnicodeCSV()
  2. Set oAdoS = CreateObject("ADODB.Stream")

  3.     oAdoS.Charset = "UTF-8"
  4.     oAdoS.Mode = 3
  5.     oAdoS.Type = 2
  6.     oAdoS.Open

  7. lRow = 1
  8. lCol = 1
  9. Do Until Sheets(1).Cells(lRow, lCol).Value = ""
  10.   oAdoS.WriteText (Sheets(1).Cells(lRow, lCol).Text)
  11.   lCol = lCol + 1
  12.   Do Until Sheets(1).Cells(lRow, lCol).Value = ""
  13.    oAdoS.WriteText ("," & Sheets(1).Cells(lRow, lCol).Text)
  14.    lCol = lCol + 1
  15.   Loop
  16.   oAdoS.WriteText (vbCrLf)
  17.   lCol = 1
  18.   lRow = lRow + 1
  19. Loop

  20. oAdoS.SaveToFile "c:\test.csv", 2
  21. oAdoS.Close
  22. Set oAdoS = Nothing
  23. End Sub
複製代碼





歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)