• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1035
  • Last Modified:

Export/Save worksheet as csv but keep original workbook open

Is there a simple way to display the save as dialogue, allow the user to select a location and then save a copy of the active sheet as a csv to the location the user supplies without closing the original workbook?

I'm using the following code, however the original workbook gets automatically closed and the newly saved csv is left open....
Public Sub subSaveAsCSV()
Dim strFolderPath As String
Dim strFilePath As String
strFolderPath = Application.ActiveWorkbook.Path & "\"
strFilePath = Application.GetSaveAsFilename(strFolderPath, "CSV (Comma delimited) (*.csv), *.csv")
If strFilePath <> "False" Then
    ' Check if the file path already exists
    If Not Dir(strFilePath) <> "" Then
        ' If it doesn't exist then save it
        GoTo EOF
    Else
        ' Trap the error and ignore it
        On Error Resume Next
        If Err.Number = 1004 Then
            On Error GoTo 0
        Else ' User presses Save
            GoTo EOF
        End If
    End If
Else
    End
End If

EOF:
    With ActiveWorkbook
        .SaveAs Filename:=strFilePath, FileFormat:=xlCSV
    End With
End Sub

Open in new window


Thanks
0
antonioking
Asked:
antonioking
1 Solution
 
Rgonzo1971Commented:
Hi,

pls try

Public Sub subSaveAsCSV()
Dim strFolderPath As String
Dim strFilePath As String
strFolderPath = Application.ActiveWorkbook.Path & "\"
strFilePath = Application.GetSaveAsFilename(strFolderPath, "CSV (Comma delimited) (*.csv), *.csv")
If strFilePath <> "False" Then
    ' Check if the file path already exists
    If Not Dir(strFilePath) <> "" Then
        ' If it doesn't exist then save it
        GoTo EOF
    Else
        ' Trap the error and ignore it
        On Error Resume Next
        If Err.Number = 1004 Then
            On Error GoTo 0
        Else ' User presses Save
            GoTo EOF
        End If
    End If
Else
    End
End If

EOF:
    Application.ScreenUpdating = False
    ActiveSheet.Copy
    With ActiveWorkbook
        .SaveAs Filename:=strFilePath, FileFormat:=xlCSV
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 
antoniokingAuthor Commented:
Perfect!
Thank you!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now