返回列表 上一主題 發帖

[發問] 關於VBA將EXCEL分頁另存為文字檔的問題

[發問] 關於VBA將EXCEL分頁另存為文字檔的問題

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

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

請問各位大大,是否有方式可以另存為文字檔之後,還能保持內容不變呢?
感謝回答
  1. Dim theName As String
  2. Dim i As Integer

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

本帖最後由 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

TOP

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

TOP

回復 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

TOP

回復 3# 准提部林


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

TOP

回復 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

TOP

回復 4# quickfixer


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

TOP

本帖最後由 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

TOP

        靜思自在 : 看別人不順眼,是自己修養不夠。
返回列表 上一主題