標題: [發問] 關於VBA將EXCEL分頁另存為文字檔的問題 [打印本頁]

---

作者: suchblue    時間: 2021-11-19 20:46     標題: 關於VBA將EXCEL分頁另存為文字檔的問題

目的是將EXCEL分頁的每一頁都另存為一個文字檔
但只要文字內容有半形逗號
則該欄內容前後會被加上""

例如EXCEL內容為：
ABC
ABC,
ABC,}
另存為文字檔後內容變成
ABC
"ABC,"
"ABC,}"

請問各位大大，是否有方式可以另存為文字檔之後，還能保持內容不變呢?
感謝回答

1. Dim theName As String
   
2. Dim i As Integer
   
3. 
   
4. Sub SaveSheetsAsTXT()
   
5. On Error GoTo Line1
   
6. For i = 1 To 2
   
7. ThisWorkbook.Sheets(i).Copy
   
8. theName = ThisWorkbook.Sheets(i).Name & ".txt"
   
9. ActiveWorkbook.SaveAs Filename:="D:\" & theName, FileFormat:=xlUnicodeText
   
10. ActiveWindow.Close
    
11. Next i
    
12. Line1:
    
13. End Sub

複製代碼

---

作者: quickfixer    時間: 2021-11-20 20:26

本帖最後由 quickfixer 於 2021-11-20 20:34 編輯

回復 1# suchblue


    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

---

作者: 准提部林    時間: 2021-11-21 09:20

FileFormat:=xlUnicodeText  
想轉為unicode格式??

---

作者: quickfixer    時間: 2021-11-21 18:00

回復 2# quickfixer

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

---

作者: suchblue    時間: 2021-11-22 10:11

回復 3# 准提部林


    是的，因為之前直接另存之後 繁中或是簡中都會變成亂碼

---

作者: samwang    時間: 2021-11-22 10:45

回復 1# suchblue

請測試看看，謝謝
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

---

作者: suchblue    時間: 2021-11-24 11:19

回復 4# quickfixer


感謝大大 轉成功了
但使用後發現 原來系統需要的是UTF-8 而不是UTF-16
請問該怎麼轉成UTF-8呢?
感謝回答

---

作者: quickfixer    時間: 2021-11-24 17:16

本帖最後由 quickfixer 於 2021-11-24 17:23 編輯

回復 7# suchblue


    變亂碼是簡繁轉換的問題吧?
參考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

---

作者: suchblue    時間: 2021-12-1 19:08

回復 8# quickfixer


    感謝大大，問題解決了!!

---

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