關於VBA將EXCEL分頁另存為文字檔的問題
目的是將EXCEL分頁的每一頁都另存為一個文字檔但只要文字內容有半形逗號
則該欄內容前後會被加上""
例如EXCEL內容為：
ABC
ABC,
ABC,}
另存為文字檔後內容變成
ABC
"ABC,"
"ABC,}"
請問各位大大，是否有方式可以另存為文字檔之後，還能保持內容不變呢?
感謝回答[code]Dim theName As String
Dim i As Integer
Sub SaveSheetsAsTXT()
On Error GoTo Line1
For i = 1 To 2
ThisWorkbook.Sheets(i).Copy
theName = ThisWorkbook.Sheets(i).Name & ".txt"
ActiveWorkbook.SaveAs Filename:="D:\" & theName, FileFormat:=xlUnicodeText
ActiveWindow.Close
Next i
Line1:
End Sub
[/code] [i=s] 本帖最後由 quickfixer 於 2021-11-20 20:34 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117761&ptid=23489]1#[/url] [i]suchblue[/i] [/b]
Sub test()
Dim arr As String, brr
For Each brr In sheets("工作表1").Range("a1").CurrentRegion.Rows
arr = arr & Join(Application.Transpose(Application.Transpose(brr)), vbTab) & vbCrLf
Next
Open "C:\test.txt" For Output As #1
Print #1, arr
arr=""
Close #1
End Sub FileFormat:=xlUnicodeText
想轉為unicode格式?? [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117777&ptid=23489]2#[/url] [i]quickfixer[/i] [/b]
Unicode??
Sub test()
Dim arr As String, brr
For Each brr In Sheets("工作表1").Range("a1:z100").Rows
arr = arr & Join(Application.Transpose(Application.Transpose(brr)), vbTab) & vbCrLf
Next
Dim fso As Object, txt As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.CreateTextFile("c:\test.txt", True, Unicode:=True)
txt.WriteLine arr
txt.Close
arr = ""
Set fso = Nothing
Set txt = Nothing
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117784&ptid=23489]3#[/url] [i]准提部林[/i] [/b]
是的，因為之前直接另存之後 繁中或是簡中都會變成亂碼 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117761&ptid=23489]1#[/url] [i]suchblue[/i] [/b]
請測試看看，謝謝
Sub test()
Dim Arr, Brr, Crr, FPath, sh%, i&, j%
FPath = ThisWorkbook.Path
For sh = 1 To Sheets.Count
FN = Sheets(sh).Name
Open FPath & "\" & FN & ".txt" For Output As #sh
Arr = Sheets(sh).Range("a1").CurrentRegion
ReDim Brr(1 To UBound(Arr, 2))
For i = 1 To UBound(Arr)
For j = 1 To UBound(Arr, 2)
Brr(j) = Arr(i, j)
Next
Crr = Join(Brr, " ")
Print #sh, Crr
Next
Close #sh
Next
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117788&ptid=23489]4#[/url] [i]quickfixer[/i] [/b]
感謝大大 轉成功了
但使用後發現 原來系統需要的是UTF-8 而不是UTF-16
請問該怎麼轉成UTF-8呢?
感謝回答 [i=s] 本帖最後由 quickfixer 於 2021-11-24 17:23 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117831&ptid=23489]7#[/url] [i]suchblue[/i] [/b]
變亂碼是簡繁轉換的問題吧?
參考https://stackoverflow.com/questions/31435662/vba-save-a-file-with-utf-8-without-bom
Sub test()
Dim arr As String, brr, txtutf8 As Object, txtutf8nobom As Object
For Each brr In Sheets("工作表1").Range("a1:e50").Rows '範圍
arr = arr & Join(Application.Transpose(Application.Transpose(brr)), vbTab) & vbCrLf
Next
'範圍不明用#2 .CurrentRegion.Rows, 或者改用#6 迴圈跑的Crr取代arr,比較不會抓錯範圍
Set txtutf8 = CreateObject("ADODB.Stream")
Set txtutf8nobom = CreateObject("ADODB.Stream")
With txtutf8 '有bom
.Charset = "UTF-8" '編碼
.Open
.WriteText arr
.Position = 0
.SaveToFile "c:\testutf8.txt", 2 '檔名
.Type = 2
.Position = 3
End With
With txtutf8nobom '沒bom
.Type = 1
.Open
txtutf8.copyto txtutf8nobom
.SaveToFile "c:\testutf8nobom.txt", 2
End With
txtutf8.close
txtutf8nobom.close
Set txtutf8 = Nothing
Set txtutf8nobom = Nothing
End Sub [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117840&ptid=23489]8#[/url] [i]quickfixer[/i] [/b]
感謝大大，問題解決了!!
頁:
[1]