VBA / Macro of .csv file, big data, delete commas problem :(

[pomo123]

Good day guys!

I writing you because of my problem. I don't know how to write the macro witch will help me. Please help me with my problem.
So situation is that I have several hundreds of data documents in .csv files with all text and numbers are inserted in A column and for outside of excel program I only need 257 and 263 column witch separated with commas ( ,). And I need only two columns of many and all the rows of that specific columns. Also I need to make macro with will open one file - deletes the rest or copies to other file and closes and opens next one. I think it is called "loop"? I have some kind of loop made by my self but it is not perfect :D

For example :

File a:
text,text,3452,text,text,232.232,text,hello,world,123, .... ,257,abc,abc,123,text,text,263,text,123,....
File b:
text,text,3452,text,text,232.232,text,hello,world,123, .... ,257,abc,abc,123,text,text,263,text,123,....
File abcdef:
text,text,3452,text,text,232.232,text,hello,world,123, .... ,257,abc,abc,123,text,text,263,text,123,....

andding the created loop (i call it like this) of converting the needed files to other format.

ublic Sub ConvertXmlToXlsx()
Application.DisplayAlerts = False
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
xmlFolder = Worksheets("xml_to_csv").Range("B1").Value

convFolder = Worksheets("xml_to_csv").Range("B2").Value

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(xmlFolder)
For Each objFile In objFolder.Files
    If UCase(Right(objFile.Name, Len(XML))) = UCase(XML) Then
        NewFileName = convFolder & objFile.Name & "_conv.csv"
        Set ConvertThis = Workbooks.Open(objFolder & "\" & objFile.Name)
        ConvertThis.SaveAs Filename:=NewFileName, FileFormat:= _
        xlCSV
        ConvertThis.Close
    Columns(7).EntireColumn.Delete
    End If
Next objFile

End Sub

I will order beer for fella witch will help me!

 

[John_w]

Try this macro:

Public Sub Convert_CSV_Files()

    Dim FSO As Object
    Dim FSOfolder As Object
    Dim FSOfile As Object
    Dim FSOtextStream As Object
    Dim xmlFolder As String, convFolder As String
    Dim lines As Variant, convLines() As String, csv As Variant
    Dim i As Long
   
    xmlFolder = Worksheets("xml_to_csv").Range("B1").Value
    convFolder = Worksheets("xml_to_csv").Range("B2").Value
   
    If Right(xmlFolder, 1) <> "\" Then xmlFolder = xmlFolder & "\"
    If Right(convFolder, 1) <> "\" Then convFolder = convFolder & "\"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    Set FSOfolder = FSO.GetFolder(xmlFolder)
    For Each FSOfile In FSOfolder.Files
        If LCase(FSOfile.Name) Like "*.csv" Then
            Set FSOtextStream = FSOfile.OpenAsTextStream(1)
            lines = Split(FSOtextStream.ReadAll, vbCrLf)
            FSOtextStream.Close
            ReDim convLines(UBound(lines))
            For i = 0 To UBound(lines) - 1
                csv = Split(lines(i), ",")
                'csv array starts at zero, so required array indices are one less
                convLines(i) = csv(256) & "," & csv(262)
            Next
            Set FSOtextStream = FSO.CreateTextFile(convFolder & Replace(FSOfile.Name, ".csv", "_conv.csv", Compare:=vbTextCompare), True)
            FSOtextStream.Write Join(convLines, vbCrLf)
            FSOtextStream.Close
        End If
    Next

    MsgBox "Done"

End Sub

 

[pomo123]

Try this macro:

Public Sub Convert_CSV_Files()

    Dim FSO As Object
    Dim FSOfolder As Object
    Dim FSOfile As Object
    Dim FSOtextStream As Object
    Dim xmlFolder As String, convFolder As String
    Dim lines As Variant, convLines() As String, csv As Variant
    Dim i As Long
  
    xmlFolder = Worksheets("xml_to_csv").Range("B1").Value
    convFolder = Worksheets("xml_to_csv").Range("B2").Value
  
    If Right(xmlFolder, 1) <> "\" Then xmlFolder = xmlFolder & "\"
    If Right(convFolder, 1) <> "\" Then convFolder = convFolder & "\"
  
    Set FSO = CreateObject("Scripting.FileSystemObject")
  
    Set FSOfolder = FSO.GetFolder(xmlFolder)
    For Each FSOfile In FSOfolder.Files
        If LCase(FSOfile.Name) Like "*.csv" Then
            Set FSOtextStream = FSOfile.OpenAsTextStream(1)
            lines = Split(FSOtextStream.ReadAll, vbCrLf)
            FSOtextStream.Close
            ReDim convLines(UBound(lines))
            For i = 0 To UBound(lines) - 1
                csv = Split(lines(i), ",")
                'csv array starts at zero, so required array indices are one less
                convLines(i) = csv(256) & "," & csv(262)
            Next
            Set FSOtextStream = FSO.CreateTextFile(convFolder & Replace(FSOfile.Name, ".csv", "_conv.csv", Compare:=vbTextCompare), True)
            FSOtextStream.Write Join(convLines, vbCrLf)
            FSOtextStream.Close
        End If
    Next

    MsgBox "Done"

End Sub

Hi John, It seems like it do not work, or I am too bad to understand. It just shows done and macro doing nothing to files.... Is they should be put somewhere in fso folder?

 

[pomo123]

Hi John, It seems like it do not work, or I am too bad to understand. It just shows done and macro doing nothing to files.... Is they should be put somewhere in fso folder?

in debug mode almost all code from

If LCase(FSOfile.Name) Like "*.csv"

skips

 

[John_w]

What is the file extension of the files? The code expects the extension to be ".csv".

 

[pomo123]

OH Sorry my bad! I was putting in the different direction. it works! Now lets go with the beer. How i should provide that for you? :D

 

[John_w]

No worries! Just mark the thread as solved.