Xuất dữ liệu từ Excell ra file text định dạng UTF-8

Liên hệ QC

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆
Tham gia
17/12/10
Bài viết
2,476
Được thích
2,931
Giới tính
Nam
Chào các thầy cô.
Em có Viết 1 đoạn Code để xuất dữ liệu ra 1 file text được chỉ định.
Mã:
Sub XuatDL()
Dim Arr(), i&, x&, k&
Dim fso As Object, MyFile  As Object
Dim FileName As String
   Set fso = CreateObject("Scripting.FileSystemObject")
   FileName = "C:\Users\VCong\AppData\Roaming\IBM\Client Access\Emulator\private\A1.mac"
   Set MyFile = fso.CreateTextFile(FileName, True, True)
With Sheets("KQ")
    Arr = .Range("G3:J" & .Range("G" & Rows.Count).End(3).Row).Value
End With
For i = 1 To UBound(Arr, 1)
    With Sheets("TEXT")
        .Cells(8, 1).Value = """" & Sheets("KQ").Range("F1").Value
        .Cells(10, 1).Value = """" & Arr(i, 1)
        .Cells(16, 1).Value = """" & Arr(i, 2)
        .Cells(18, 1).Value = """" & Arr(i, 3)
        .Cells(20, 1).Value = """" & Format(Arr(i, 4), "yyyymmdd")
    End With
    With MyFile
        If i = 1 Then
        .WriteLine Cells(1, 1)
        End If
      For x = 2 To 24
         .WriteLine Cells(x, 1)
      Next
   End With
Next
MyFile.Close
End Sub
Xuất ra file text thì được rồi. Nhưng nó lại ở định dạng Unicode.
Do còn phải làm việc thêm với file text đó mà bản thân em muốn lưu nó dạng UTF- 8 như hình
1632834062496.png
mà lại không biết sửa code chỗ nào.
Mong mọi người chỉ giúp ạ.
Em xin cám ơn nhiều
 
Chào các thầy cô.
Em có Viết 1 đoạn Code để xuất dữ liệu ra 1 file text được chỉ định.
Mã:
Sub XuatDL()
Dim Arr(), i&, x&, k&
Dim fso As Object, MyFile  As Object
Dim FileName As String
   Set fso = CreateObject("Scripting.FileSystemObject")
   FileName = "C:\Users\VCong\AppData\Roaming\IBM\Client Access\Emulator\private\A1.mac"
   Set MyFile = fso.CreateTextFile(FileName, True, True)
With Sheets("KQ")
    Arr = .Range("G3:J" & .Range("G" & Rows.Count).End(3).Row).Value
End With
For i = 1 To UBound(Arr, 1)
    With Sheets("TEXT")
        .Cells(8, 1).Value = """" & Sheets("KQ").Range("F1").Value
        .Cells(10, 1).Value = """" & Arr(i, 1)
        .Cells(16, 1).Value = """" & Arr(i, 2)
        .Cells(18, 1).Value = """" & Arr(i, 3)
        .Cells(20, 1).Value = """" & Format(Arr(i, 4), "yyyymmdd")
    End With
    With MyFile
        If i = 1 Then
        .WriteLine Cells(1, 1)
        End If
      For x = 2 To 24
         .WriteLine Cells(x, 1)
      Next
   End With
Next
MyFile.Close
End Sub
Xuất ra file text thì được rồi. Nhưng nó lại ở định dạng Unicode.
Do còn phải làm việc thêm với file text đó mà bản thân em muốn lưu nó dạng UTF- 8 như hình
View attachment 266886
mà lại không biết sửa code chỗ nào.
Mong mọi người chỉ giúp ạ.
Em xin cám ơn nhiều
Thử với cái này:

Mã:
Sub Test_utf_8()

    Dim st As ADODB.Stream
    Dim sPathname As String
    
    sPathname = "c:\tmp\test_utf-8.txt"
    
    ' create a stream object
    Set st = New ADODB.Stream
    
    ' set properties
    st.Charset = "utf-8"
    st.Type = adTypeText
    
    ' open the stream object and write some text
    st.Open
    st.WriteText "This is a test"
    
    ' save
    st.SaveToFile sPathname, adSaveCreateOverWrite
    
End Sub
 
Upvote 0
Thử với cái này:

Mã:
Sub Test_utf_8()

    Dim st As ADODB.Stream
    Dim sPathname As String
  
    sPathname = "c:\tmp\test_utf-8.txt"
  
    ' create a stream object
    Set st = New ADODB.Stream
  
    ' set properties
    st.Charset = "utf-8"
    st.Type = adTypeText
  
    ' open the stream object and write some text
    st.Open
    st.WriteText "This is a test"
  
    ' save
    st.SaveToFile sPathname, adSaveCreateOverWrite
  
End Sub
Em cám ơn anh ạ. Như đoạn code trên. Sẽ thực hiện sau khi em chạy code của em đúng không anh?
Cái st.writetext là nó có chức năng ghi lại toàn bộ trên file text cũ phải không anh
Sau đó là nó lưu lại phải không anh nhỉ
 
Upvote 0
Em cám ơn anh ạ. Như đoạn code trên. Sẽ thực hiện sau khi em chạy code của em đúng không anh?
Cái st.writetext là nó có chức năng ghi lại toàn bộ trên file text cũ phải không anh
Sau đó là nó lưu lại phải không anh nhỉ
Trời, bạn cứ tùy biến đặt một biến String rồi gán vào

Dim strText As String
strText = "This is a test"
st.WriteText strText

Biến strText bạn muốn nội dung gì mà chả được.
 
Upvote 0
Trời, bạn cứ tùy biến đặt một biến String rồi gán vào

Dim strText As String
strText = "This is a test"
st.WriteText strText

Biến strText bạn muốn nội dung gì mà chả được.
Xin lỗi anh. Đọc lại em thấy mình hỏi ngu quá. Em hiểu rồi ạ. Để em thử. Có gì em ko hiểu. Em xin phép được hỏi lại ạ
 
Upvote 0
Ơn giời. Thiệt sự em tìm mà không thấy luôn. Cứ ngồi đọc đâu đâu cả mấy giờ. Mà loay hoay không biết sửa chỗ nào. Nhớ là có lần đọc đâu đó trên diễn đàn rồi nhưng lại không tìm lại được. Anh có thể chỉ cho em cách mà anh tìm kiếm từ khoá trên diễn đàn để nó bó phạm vi tìm kiếm được không ạ. Nếu lỡ có hỏi ngu thì xin anh bỏ qua cho ạ.Cám ơn anh nhiều ạ.
 
Upvote 0
Anh có thể chỉ cho em cách mà anh tìm kiếm từ khoá trên diễn đàn để nó bó phạm vi tìm kiếm được không ạ. Nếu lỡ có hỏi ngu thì xin anh bỏ qua cho
Cái này có mẹo, kỹ thuật cả, chứ không có gì là ngốc cả mà ái ngại.
Mình viết bài thường viết từ khoá gì đó, sau này có tìm lại bài của chính mình thì gõ từ đó và tìm theo nick của mình.
Với bài này của bạn thì gõ từ khoá là charset hoặc utf-8, và nick của mình là có kết quả.
 
Upvote 0
Cái này có mẹo, kỹ thuật cả, chứ không có gì là ngốc cả mà ái ngại.
Mình viết bài thường viết từ khoá gì đó, sau này có tìm lại bài của chính mình thì gõ từ đó và tìm theo nick của mình.
Với bài này của bạn thì gõ từ khoá là charset hoặc utf-8, và nick của mình là có kết quả.
Thật sự luôn á. Nhiều lúc em từng đọc nhiều bài viết hay lắm á. Tại lúc đọc. Cũng lơ mơ là sau này thế nào cũng có lúc dùng tới. Mà tới lúc dùng tới. Không tài nào tìm được. Em xin cám ơn anh 1 lần nữa. Để em vọc vạch thêm. Do em xuất được ra file text rồi. Khi dùng file text ấy input vào phần mềm của công ty mà nó không chấp nhận. Loay hoay mãi mới phát hiện ra nó đang ở Encoding: Unicode. Save sang dạng UTF-8 là được liền. Mà mất mấy tiếng. Cuối cùng đành hỏi các thầy cô và anh chị trên diễn đàn. cám ơn anh nhiều ạ
 
Upvote 0
Web KT
Back
Top Bottom