EXCEL VBA如何將txt存檔預設編碼轉換UTF-8

excel vba vba #excel #vba

peterzxcv 2021-02-27 08:33:37 ‧ 7002 瀏覽

分享至

Sub A_Click()
Dim ST As Worksheet
Dim MB As Workbook
Set MB = ActiveWorkbook
For Each ST In MB.Sheets
ST.Copy
ActiveWorkbook.SaveAs Filename:=MB.Path & "" & ST.Name & ".txt", FileFormat:=xlUnicodeText
ActiveWorkbook.Close
Next
End Sub
以上是小弟批量將各工作表產出為txt格式，但excel預設非UTF-8編碼(不具BOM)，該如何加寫，求大神解惑~

goodnight iT邦研究生 2 級 ‧ 2024-01-21 10:29:57 檢舉

方法都一樣, 順便記錄一下
參考網址: https://stackoverflow.com/questions/2524703/save-text-file-utf-8-encoded-with-vba
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
fsT.WriteText "special characters: äöüß"
fsT.SaveToFile sFileName, 2 'Save binary data To disk

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

2 個回答

rogeryao

iT邦超人 7 級 ‧ 2021-02-27 12:51:29

最佳解答

Private Sub CommandButton1_Click()
'Option Explicit

Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Const adTypeBinary = 1
Const adTypeText = 2

Dim objStreamUTF8: Set objStreamUTF8 = CreateObject("ADODB.Stream")
Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")

With objStreamUTF8
  .Charset = "UTF-8"
  .Open
  .WriteText "aAo"
  .Position = 0
  .SaveToFile "D:\toto.php", adSaveCreateOverWrite
  .Type = adTypeText
  .Position = 3
End With

With objStreamUTF8NoBOM
  .Type = adTypeBinary
  .Open
  objStreamUTF8.CopyTo objStreamUTF8NoBOM
  .SaveToFile "D:\toto-nobom.php", adSaveCreateOverWrite
End With

objStreamUTF8.Close
objStreamUTF8NoBOM.Close
End Sub

請參閱 : VBA : save a file with UTF-8 without BOM

回應 7
分享
檢舉

看更多先前的回應...收起先前的回應...

peterzxcv iT邦新手 5 級 ‧ 2021-02-27 18:27:23 檢舉

Private Sub CommandButton1_Click()
'Option Explicit

Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Const adTypeBinary = 1
Const adTypeText = 2

Dim objStreamUTF8: Set objStreamUTF8 = CreateObject("ADODB.Stream")
Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")

With objStreamUTF8
.Charset = "UTF-8"
.Open
.SaveToFile "C:\A\1.txt", adSaveCreateOverWrite
.Type = adTypeText
End With

With objStreamUTF8NoBOM
.Type = adTypeBinary
.Open
objStreamUTF8.CopyTo objStreamUTF8NoBOM
.SaveToFile "C:\A\1U.txt", adSaveCreateOverWrite
End With

objStreamUTF8.Close
objStreamUTF8NoBOM.Close
End Sub

謝謝rogeryao大大，是有變UTF-8不具BOM，因為上方有些問題我有刪掉一些部分不是很懂得部分，例如.WriteText "aAo"
.Position = 0還有.Position = 3，.Position = 3這會卡住出錯，我覺得這語法是套其他元件強制變更，並開啟檔案我原本檔再存檔為UTF-8，但資料內容卻消失，再煩請rogeryao大大解說一下，謝謝

rogeryao iT邦超人 7 級 ‧ 2021-02-27 19:11:34 檢舉

1.WriteText "aAo" : 是範例文字
請參閱 :ADO Stream Object
2.Position = 3 :UTF- 8編碼的檔案中，BOM佔三個位元組
請參閱 :「帶 BOM 的 UTF-8」和「無 BOM 的 UTF-8」有什麼區別
3.請參閱 :“vba read file line by line” Code Answer

peterzxcv iT邦新手 5 級 ‧ 2021-02-27 20:05:40 檢舉

小弟正因帶BOM的UTF-8導入第三方軟體成亂碼才需要，跟php也有編碼上相近，但ADO都是針對Stream object，我還是不大清楚能怎麼撰寫VBA，是否能直接開啟我原本預存非UTF-8的txt檔，並存為無BOM UTF-8的txt語法，例如小弟在第一段導出C:\A\1.txt(非UTF-8且內有資料)，第二階段串接rogeryao大的轉檔，這能怎麼銜接，請rogeryao大幫忙，謝謝

rogeryao iT邦超人 7 級 ‧ 2021-02-27 21:16:40 檢舉

1.先建立 D:\Test 目錄來存放轉成 UTF-8 無 BOM 的檔案
2.海綿寶寶提供的 FileFormat:=xlCSVUTF8

Private Sub CommandButton1_Click()
Dim ST As Worksheet
Dim MB As Workbook
Set MB = ActiveWorkbook
For Each ST In MB.Sheets
ST.Copy
ActiveWorkbook.SaveAs Filename:=MB.Path & "\" & ST.Name & ".txt", FileFormat:=xlCSVUTF8
ActiveWorkbook.Close
ConvertToUTF8NoBOM MB.Path & "\" & ST.Name & ".txt", ST.Name & ".txt"
Next
End Sub

Sub ConvertToUTF8NoBOM(MyFilePath As String, MyFileName As String)
'Option Explicit

Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Const adTypeBinary = 1
Const adTypeText = 2

Dim objStreamUTF8: Set objStreamUTF8 = CreateObject("ADODB.Stream")
Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")

With objStreamUTF8
  .Charset = "UTF-8"
  .Open
  '.WriteText "aAo"
  .LoadFromFile MyFilePath
  .ReadText
  .Position = 0
  '.SaveToFile "D:\toto.php", adSaveCreateOverWrite
  .Type = adTypeText
  .Position = 3
End With

With objStreamUTF8NoBOM
  .Type = adTypeBinary
  .Open
  objStreamUTF8.CopyTo objStreamUTF8NoBOM
  '.SaveToFile "D:\toto-nobom.php", adSaveCreateOverWrite
  .SaveToFile "D:\Test\" & MyFileName, adSaveCreateOverWrite
End With

objStreamUTF8.Close
objStreamUTF8NoBOM.Close

End Sub