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
Asked
Active
Viewed 4,049 times
-1
-
I am very new to excel macros. I need VBA code if you can help please – heywahab Aug 13 '14 at 15:32
-
1If you just need it done, but don't want to make an effort yourself one could hire a developer. We need some effort so that it is a learning experience. – Halvor Holsten Strand Aug 13 '14 at 15:35
-
@heywahab .. Ondkloss is correct but will give you this one. See example below – Tak Aug 13 '14 at 15:51
2 Answers
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