Export and name sheets within a workbook to a text file in same directory as workbook

[djdbg1]

I have a workbook with 9 sheets, all named.
I want to export 3 of these sheets and save as txt files
I want to determine the saved name to include TODAYS date
I want to save in same location as the workbook exists.

I tried recording macro and going through steps, but it means saved name and location is always the same. I create a new folder and workbook each day, so this means overwriting original file every time and in wrong days folder.
I found the following script which does save in same directory as workbook, but it saves all sheets and names them same as sheet name. I have tried using bits from each but constant run time errors and cant get it to work, woudl appreciate any suggestions?

Sub Worksheets_to_txt() '<--Saves each worksheet as a text file with the same name

    Dim ws As Worksheet
    Dim relativePath As String
    Dim answer As VbMsgBoxResult

    relativePath = ActiveWorkbook.Path

    answer = MsgBox("Are you sure you want to export worksheets?", vbYesNo, "Run Macro") '<--Pop up box to confirm export

    If answer = vbYes Then

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets

        ws.Select
        ws.Copy
        ActiveWorkbook.SaveAs Filename:= _
        relativePath & "\" & ws.Name & ".txt", _
        FileFormat:=xlText, CreateBackup:=False
        ActiveWorkbook.Close
        ActiveWorkbook.Activate
    Next
     End If

End Sub

 

[rlv01]

Not tested.

Sub Worksheets_to_txt()                               '<--Saves each worksheet as a text file with the same name
    
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim FileSavePathName As String
    Dim answer As VbMsgBoxResult
    Dim DoExport As Boolean
    
    Set WB = ActiveWorkbook
    
    answer = MsgBox("Are you sure you want to export worksheets?", vbYesNo, "Run Macro") '<--Pop up box to confirm export
    
    If answer = vbYes Then
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        For Each WS In WB.Worksheets
            Select Case WS.Name
                Case "Sheet1", "Sheet2", "Sheet1"         'list worksheets to export here
                    FileSavePathName = WB.Path & "\" & WS.Name & "_" & VBA.Format(Date, "YYYYMMDD") & ".txt"
                    DoExport = True
                    
                    'Msgbox code can be removed later if desired
                    Select Case MsgBox("Export worksheet?" & vbCr & vbCr & FileSavePathName, vbYesNoCancel Or vbQuestion, "Text File Export")
                        Case vbYes
                            DoExport = True
                        Case vbNo
                            DoExport = False
                        Case vbCancel
                            Exit Sub
                    End Select
                    
                    If DoExport Then
                        WS.Copy                           'make temporary workbook
                        With ActiveWorkbook
                            .SaveAs Filename:=FileSavePathName, FileFormat:=xlText, CreateBackup:=False 'export as textfile.
                            DoEvents
                            .Close False                  'close temporary workbook
                        End With
                    End If
            End Select
        Next WS
    End If
End Sub

 

[djdbg1]

Not tested.

Sub Worksheets_to_txt()                               '<--Saves each worksheet as a text file with the same name
   
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim FileSavePathName As String
    Dim answer As VbMsgBoxResult
    Dim DoExport As Boolean
   
    Set WB = ActiveWorkbook
   
    answer = MsgBox("Are you sure you want to export worksheets?", vbYesNo, "Run Macro") '<--Pop up box to confirm export
   
    If answer = vbYes Then
       
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
       
        For Each WS In WB.Worksheets
            Select Case WS.Name
                Case "Sheet1", "Sheet2", "Sheet1"         'list worksheets to export here
                    FileSavePathName = WB.Path & "\" & WS.Name & "_" & VBA.Format(Date, "YYYYMMDD") & ".txt"
                    DoExport = True
                   
                    'Msgbox code can be removed later if desired
                    Select Case MsgBox("Export worksheet?" & vbCr & vbCr & FileSavePathName, vbYesNoCancel Or vbQuestion, "Text File Export")
                        Case vbYes
                            DoExport = True
                        Case vbNo
                            DoExport = False
                        Case vbCancel
                            Exit Sub
                    End Select
                   
                    If DoExport Then
                        WS.Copy                           'make temporary workbook
                        With ActiveWorkbook
                            .SaveAs Filename:=FileSavePathName, FileFormat:=xlText, CreateBackup:=False 'export as textfile.
                            DoEvents
                            .Close False                  'close temporary workbook
                        End With
                    End If
            End Select
        Next WS
    End If
End Sub

Thank you very much for this. It has indeed worked very well for me, much appreciated.

 

[rlv01]

You're welcome.