|Posted by [email protected] on March 17, 2017 at 11:40 AM|
Dim xx As String
Dim MyPATH As String
Dim FileNAME As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyPATH = InputBox("Enter the path where you want to keep generated CSV files", "Enter the Path")
If MyPATH = vbNullString Then
MsgBox "Command Cancelled, Please retry", vbExclamation, "Command Cancelled"
.AllowMultiSelect = True
.Title = "Please select the required Text file"
.Filters.Add "Excel Files", "*.xlsx"
For p = 1 To .SelectedItems.Count
xx = .SelectedItems(p)
MyFileName = ActiveWorkbook.Name
master = ActiveWorkbook.Name
Application.StatusBar = " We are working on file name :---> " & master
lc = ActiveSheet.Range("XFD1").End(xlToLeft).Column
lr = ActiveSheet.Range("A1048576").End(xlUp).Row
temp = ""
n = ""
For r = 1 To lr
For c = 1 To lc
temp = Cells(r, c).Value
n = n & "|" & temp
n = Right(n, Len(n) - 1)
Range("A" & r).Value = n
temp = "" ' Reseting Temp to blank Again
n = "" 'Reseting n to blank Again
FileNAME = ActiveWorkbook.Name
FileNAME = Left(FileNAME, Len(FileNAME) - 5) ' REMOVE XLS EXTENSION
FileNAME = FileNAME & ".csv" ' ADD CSV EXTENSION
Application.DisplayAlerts = False ' REMOVE DISPLAY MESSAGE: PREVIOUS FILE WILL BE ERASED
ActiveWorkbook.SaveAs FileNAME:= _
MyPATH & "\" & FileNAME, FileFormat:=xlCSV, _
Application.DisplayAlerts = True ' RESTAURE DISPLAY MESSAGE
Application.StatusBar = Clear
MsgBox "CSV files generated Successfully; Please check on Below mentioned Location " & vbCrLf & vbCrLf & MyPATH