Save Excel 2010 File In CSV Format VBA

[mag]

I am using EXCEL 2010 in windows 7.

I have a simple file

I need to do these things via VBA.

Copy Selected Range !A1:Q251
Ask an Inputbox for the file name
Save As file in CSV format in the below location
C:\Users\Mag\Desktop\Revenue 2012
Needs to create Converted folder, if not exists.

Appreciate all your help

Mag

[LalitPandey87]

Please download below file with the solution.

SaveDataAsCSV.xlsm

Change code accordingly.

[mag]

Thanks For your help .. but i need to do some changes. i need to put only Name .. Select Range option Should be in VBA Code Eg A1:C20 no need to prompt msg Box to Select Range

[LalitPandey87]

Replace previous GetData Procedure with this one

Sub GetData()

    Dim rngDataRange                As Range
    
    Set rngDataRange = ActiveSheet.Range("A1:C20")
    
    If Not rngDataRange Is Nothing and rngDataRange.Rows.Count > 0 Then
        DataSaveAs rngDataRange, XL_CSV
    End If
    
    Set rngDataRange = Nothing
     
End Sub

Change Range accordingly.

[mag]

Thanks Buddy.. You are the Man

[mag]

Hi Can U Please Help me to Change The file Accordingly Please Find the Attached Sample File.

I need Do Some Changes For Current VBA Which i Using to Change File Path , File Name, File Range if i Change from the Current Sheet Example E1,E2,E3 When I change E1 it should Change file Path When I Change E2 it Should Change File Range When I Change E3 it Should Change File Name

Also When i Save File to CSV Date Should Be Same As Shown 01/07/2013

SaveDataAsCSV.xlsm


Thanks
Regards
Mag

[LalitPandey87]

Please change the old procedure DataSaveAs with this one

Private Sub DataSaveAs(ByVal strFilePath As String, ByVal strFileName As String, ByVal strShtName As String, ByVal strDataRange As String, ByVal SaveAs As FileType)
    
    Dim wbkSrc                      As Workbook
    Dim wksSrcSht                   As Worksheet
    Dim rngData                     As Range
    
    strFileName = vbNullString
    On Error Resume Next
    If Right(strFilePath, 1) <> Application.PathSeparator Then
        strFilePath = strFilePath & Application.PathSeparator
    End If
    strFileName = strFilePath & strFileName
    Set wbkSrc = Nothing
    Set wbkSrc = Workbooks.Open(strFileName, , True)
    On Error GoTo -1: Err.Clear
    
    If wbkSrc Is Nothing Then
        MsgBox "Please check File Name/Path is valid or not.", vbCritical, "Abort..."
        Exit Sub
    Else
        On Error Resume Next
        Set wksSrcSht = Nothing
        Set wksSrcSht = wbkSrc.Worksheets(strShtName)
        On Error GoTo 0: On Error GoTo -1: Err.Clear
    End If
    
    If wksSrcSht Is Nothing Then
        MsgBox "Provided sheet name is not exist.", vbCritical, "Abort..."
        Exit Sub
    End If
    
    If Application.DisplayAlerts Then Application.DisplayAlerts = False
    If Application.ScreenUpdating Then Application.ScreenUpdating = False
    
    With Workbooks.Add(1)
        Set rngData = wksSrcSht.Range(strDataRange)
        .Worksheets(1).Range("A1").Resize(rngData.Rows.Count, rngData.Columns.Count).Value = rngData.Value
        wbkSrc.Close 0
        Call FolderExists
        .SaveAs Filename:=strFullPath & strFileName, FileFormat:=SaveAs, CreateBackup:=False
        .Close
    End With
    
    Set wbkSrc = Nothing
    Set wksSrcSht = Nothing
    Set rngData = Nothing
    
    If Not Application.DisplayAlerts Then Application.DisplayAlerts = True
    If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
    
End Sub

Please provide sheet name from which the data you want and file name should always be with extension and call procedure as below

call DataSaveAs("C:\Users\hrasheed\Desktop\Test\halau","Test.xls", "Sheet1","D4:L20",XL_CSV)

[mag]

hi Dear Thanks For the Reply Can u Please send Me a Sample File i have tried that code it seems something going Wrong