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

pomo123

New Member
Joined
Aug 25, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
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.
VBA Code:
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!
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Try this macro:
VBA Code:
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
 
Upvote 0
Solution
Try this macro:
VBA Code:
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?
 
Upvote 0
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
VBA Code:
If LCase(FSOfile.Name) Like "*.csv"
skips
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top