CSV formatindaki dosyayi ayni isimle kaydetme

[fredycrouger]

Merhaba,

Elimde yuzlerce CSV formatinda dosya var ve icerisindeki veriler virgul ile ayrilmis sekilde gorunuyor. Klasor icindeki her dosyayi acip list seperator ile verileri ayirip tekrar ayni isimle kaydetmek istiyorum. Isime yarayabilecek bir kod buldum fakat "farkli kaydet" seklinde ayni dosyanin uzerine CSV formatinda kaydedemedim. sonuc olarak format dahada bozuk bir hale geliyor.

Asagidaki kod tam istedigim sekilde calisiyor fakat kaydetme kismini cozemedim

Workbooks(MyFile).Close SaveChanges:=True - kismini nasil save as seklinde degistirebilirim (ayrica ayni dosya uzerine yazarken eminmisiniz diye sormamali)?

Simdiden yardimlariniz icin cok tesekkurler.

Sub File_Loop_Example()
    
    Dim MyFolder As String, MyFile As String

    
    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    MyFile = Dir(MyFolder & "\", vbReadOnly)

    Do While MyFile <> ""
        DoEvents
        On Error GoTo 0
        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
        
        Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=",", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
        
        
0
        
        Workbooks(MyFile).Close SaveChanges:=True
        MyFile = Dir
              
        
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationManual

    End Sub

 

[Emir Hüseyin Çoban]

.

Test etmek için örnek dosya ile destelemenizde fayda var.

.

 

[fredycrouger]

.

Test etmek için örnek dosya ile destelemenizde fayda var.

.

Merhaba,

Ornek dosyayi zip klasoru icerisinde ekliyorum. "Orijinal" dosyasi islem gormemis orijinal format, "Dogru format" olmasi gereken hali.

Elimdeki makro kodu yukarida ekli zaten.

Tesekkurler

easyupload.io

easyupload.io

easyupload.io

 

[veyselemre]

Sub textTirnaklariAt()
    On Error GoTo hata
    Dim MyFolder As String, MyFile As String
    Dim bl
    MyFolder = ThisWorkbook.Path & "\"

    With CreateObject("Scripting.FileSystemObject")
        MyFile = Dir(MyFolder & "\*.csv")

        Do Until MyFile = ""

            If Not MyFile Like "yeni_*" Then

                fName = MyFolder & MyFile
                With .OpenTextFile(fName)
                    mytext = Replace(.readall, Chr(34), "")
                    .Close
                End With

                fName = MyFolder & "yeni_" & MyFile

                With .CreateTextFile(fName, True)
                    For Each sat In Split(mytext, vbCrLf)
                        If Trim(sat <> "") Then
                            bl = Split(sat, ",")
                            ReDim Preserve bl(0 To 8)
                            sat = Join(bl, ",")
                            .WriteLine sat
                        End If
                    Next
                    .Close
                End With
            End If
            MyFile = Dir()
        Loop
    End With
    Exit Sub
hata:
    MsgBox Err.Description
End Sub