Click here to edit title

lets learn together

Download

Generate CSV

Posted by [email protected] on March 17, 2017 at 11:40 AM

Sub Prince_GenerateCSV()

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"

Exit Sub

End If

 

 

With Application.FileDialog(msoFileDialogOpen)

.AllowMultiSelect = True

.Title = "Please select the required Text file"

.Filters.Clear

.Filters.Add "Excel Files", "*.xlsx"

.Show

For p = 1 To .SelectedItems.Count

xx = .SelectedItems(p)

Workbooks.Open (xx)

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

Next

n = Right(n, Len(n) - 1)

Range("A" & r).Value = n

temp = "" ' Reseting Temp to blank Again

n = "" 'Reseting n to blank Again

Next

 

Rows(1).Delete shift:=xlUp

Range("B:XFD").ClearContents

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, _

CreateBackup:=False

ActiveWindow.Close

Application.DisplayAlerts = True ' RESTAURE DISPLAY MESSAGE

Next

 

Application.StatusBar = Clear

End With

MsgBox "CSV files generated Successfully; Please check on Below mentioned Location " & vbCrLf & vbCrLf & MyPATH

End Sub

 

Categories: Loops, Workbooks, Error Handling

Post a Comment

Oops!

Oops, you forgot something.

Oops!

The words you entered did not match the given text. Please try again.

Already a member? Sign In

0 Comments