TXT Kayıt Hatası

[ozuberk]

Merhaba aşağıdaki kod ile txt dosyası oluşturuyorum. Oluşan dosyanın txt “UTF-8” formatı olması gerekiyor ama kayıt sonrası baktığımda dosya formatı “Ürün Reçetesi ile UTF- 8“ formatında kayıt yapıyor. Konu hakkında bilgisi olan varsa yardımcı olabilir misiniz?


Sub Text()
Dim ws As Worksheet
Dim rng As Range
Dim i As Long
Dim txtLines As String
Dim filePath As String
Dim stream As Object

Set ws = ThisWorkbook.Sheets(1)

' B2:B501 aralığındaki hücreleri kontrol et
For i = 2 To 501
If Trim(ws.Cells(i, "B").Value) <> "" Then
txtLines = txtLines & ws.Cells(i, "V").Value & vbCrLf
End If
Next i

' Kaydedilecek dosya yolu
filePath = Application.ThisWorkbook.Path & "\Veriler.txt"

' UTF-8 ile dosyaya yazma
Set stream = CreateObject("ADODB.Stream")
With stream
.Charset = "utf-8"
.Open
.WriteText txtLines
.SaveToFile filePath, 2
.Close
End With

Set stream = Nothing
MsgBox "Dosya başarıyla oluşturuldu: " & filePath

End Sub

[erseldemirel]

....
....
filePath = Application.ThisWorkbook.Path & "\Veriler.txt"

buradan itibaren kodları böyle yapsan

Kod: Tümünü seç

filePath = Application.ThisWorkbook.Path & "\Veriler.txt"
    Open filePath For Output As #1
    Print #1, txtLines
    Close #1
    cmd = "powershell -Command ""Get-Content -Path '" & filePath & "' | Set-Content -Path '" & filePath & "' -Encoding utf8"""
    Shell cmd, vbHide

End Sub

bir denersin

[SNNAY]

Deneyiniz; Önce Hayır seçeneği ile kaydediniz işinize yarayan txt dosyası ise o şekilde devam edersiniz.

Kod: Tümünü seç

Sub TxtDosyaOlustur_Secimli()
    Dim ws As Worksheet
    Dim i As Long
    Dim txtLines As String
    Dim dosyaYolu As String
    Dim secim As VbMsgBoxResult

    Set ws = ThisWorkbook.Sheets(1)

    ' Veriyi toplama (B2:B501 boş değilse V sütununu ekle)
    For i = 2 To 501
        If Trim(ws.Cells(i, "B").Value) <> "" Then
            txtLines = txtLines & ws.Cells(i, "V").Value & vbCrLf
        End If
    Next i

    ' Kullanıcıya seçenek sun
    secim = MsgBox("Dosya UTF-8 BOM ile mi kaydedilsin?" & vbCrLf & _
                   "Evet = BOM'lu" & vbCrLf & "Hayır = BOM'suz", _
                   vbYesNoCancel + vbQuestion, "Dosya Formatı Seç")

    If secim = vbYes Then
        ' UTF-8 BOM'lu kayıt
        dosyaYolu = ThisWorkbook.Path & "\Veriler_UTF8_BOMlu.txt"
        UTF8_BOMlu_Yaz txtLines, dosyaYolu
        MsgBox "Dosya UTF-8 (BOM ile) olarak kaydedildi:" & vbCrLf & dosyaYolu
    ElseIf secim = vbNo Then
        ' UTF-8 BOM'suz kayıt
        dosyaYolu = ThisWorkbook.Path & "\Veriler_UTF8_BOMsuz.txt"
        UTF8_BOMsuz_Yaz txtLines, dosyaYolu
        MsgBox "Dosya UTF-8 (BOM'suz) olarak kaydedildi:" & vbCrLf & dosyaYolu
    Else
        MsgBox "İşlem iptal edildi."
    End If
End Sub

'UTF-8 BOM’LU dosya yaz (ADODB.Stream)
Sub UTF8_BOMlu_Yaz(ByVal icerik As String, ByVal yol As String)
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    
    With stream
        .Charset = "utf-8"
        .Open
        .WriteText icerik
        .SaveToFile yol, 2 ' 2 = overwrite
        .Close
    End With
    
    Set stream = Nothing
End Sub

'UTF-8 BOM’SUZ dosya yaz
Sub UTF8_BOMsuz_Yaz(ByVal icerik As String, ByVal yol As String)
    Dim bytes() As Byte
    Dim fileNum As Integer
    
    bytes = StrConv(icerik, vbFromUnicode)
    
    fileNum = FreeFile
    Open yol For Binary As #fileNum
    Put #fileNum, , bytes
    Close #fileNum
End Sub