-1

I have a folder containing 200 text files, I want to delete two columns from every file and save it with same name and format as before. manually i can do this by opening every file in excel and then delete the column and save back withput changing the file extension. Can anybody please help with some excel macro. Thanks

heywahab
  • 1
  • 1
  • 1

2 Answers2

0
Sub ConvertFileToCSV(sPath As String)
Dim wbToConvert As Workbook
Workbooks.OpenText Filename:= _
              sPath, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
              xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
               , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
              Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
              Array(9, 1)), TrailingMinusNumbers:=True
Set wbToConvert = ActiveWorkbook
With wbToConvert
    With .Sheets(1)
        .Columns("B:B").EntireColumn.Delete
        .Columns("C:C").EntireColumn.Delete
    End With

    .SaveAs Filename:=WorksheetFunction.Substitute(sPath, ".txt", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
    .Close savechanges:=False
End With

End Sub

That will let you pass the name of the file to the function, open the workbok, remove columns B and C, then save it as a csv. From there we just need to call it, which we can do with a routine like this

Sub ConvertEach()
Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean
'Turn off screen flashing
Application.ScreenUpdating = False
'Create objects to get a listing of all files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
'Prompt user to select a directory
Do
    Problem = False
    Set ShellApp = CreateObject("Shell.Application"). _
                   Browseforfolder(0, "Please choose a folder", 0, "c:\\")
    On Error Resume Next
    'Evaluate if directory is valid
    Directory = ShellApp.self.Path
    Set SubFolder = fso.GetFolder(Directory).Files
    If Err.Number <> 0 Then
        If MsgBox("You did not choose a valid directory!" & vbCrLf & _
                  "Would you like to try again?", vbYesNoCancel, _
                  "Directory Required") <> vbYes Then Exit Sub
        Problem = True
    End If
    On Error GoTo 0
Loop Until Problem = False
'Look through each file
For Each File In SubFolder
    If Not Excludes(Right(File.Path, 3)) = True Then
        If Right(LCase(File.Path), 3) = "txt" Then
            Call ConvertFileToCSV(LCase(File.Path))
        End If
    End If
Next
End Sub
JAGS8386
  • 33
  • 1
  • 5
0

Example below uses ActiveX button and code added to Module.Module1 class

You need to add reference for the FileSystemObject .. Add Scripting Reference Required

In Module1 class (You can run this macro) ..

    Sub Macro1()
    Dim sFldr As String
    Dim fso As Scripting.FileSystemObject
    Dim fsoFile As Scripting.File
    Dim fsoFldr As Scripting.Folder

    Set fso = New Scripting.FileSystemObject

    sFldr = "C:\Temp\stackoverflow\excel\"

    Set fsoFldr = fso.GetFolder(sFldr)

    For Each fsoFile In fsoFldr.Files

        Workbooks.Open Filename:=fsoFile.Path
        Columns("E:F").Select
        Selection.Delete Shift:=xlToLeft
        ActiveWorkbook.Save
        ActiveWindow.Close
    Next fsoFile

End Sub

Added ActiveX button to call the above macro on Sheet1 ..

Private Sub CommandButton1_Click()

    Call Module1.Macro1

End Sub
Community
  • 1
  • 1
Tak
  • 1,561
  • 1
  • 9
  • 8