Excel VBA 使用另一个字段作为文件名将数据从表导出到文本文件

Question

I've got an Excel report with a table and I need to export a single column from that table to a txt file. I'm calculating the file name that I want to use for the txt file based on fields in the spreadsheet so I want to use that field as my file name.

The data I want to export is in column S.

The file name I want to use is in cell E5 and contains the file extension of txt as well.

This is what I have so far:

Sub FileNameAsCellContent()

Dim FileName As String
Dim Path As String

Application.DisplayAlerts = False

Path = "C:\temp\"
FileName = Range("E5").Value & ".txt"

ActiveWorkbook.SaveAs Path & FileName, xlTextWindows

Application.DisplayAlerts = True

MsgBox "Export Complete.  Click OK to continue"

End Sub

This works but it's exporting the entire worksheet and I only need one column out of the table.

Answer 1

This sub will save the data in Sheet1, column S to a text file.

Sub FileNameAsCellContent()

    Dim wsSource As Worksheet
    Dim fileName As String
    Dim wsDest As Worksheet
    Dim wbDest As Workbook

    Set wsWource = Worksheets("Sheet1")
    fileName = "C:\temp\" & wsSource.Cells("E5").Value & ".txt"
    
    ' Create a new worksheet.
    Set wsDest = Worksheets.Add
    
    ' Copy data from column S to new worksheet
    wsSource.Range("S:S").Copy
    wsDest.Range("A:A").PasteSpecial xlPasteValues
    
    ' Worksheet.Move with no arguments will
    ' copy the worksheet to a new workbook
    ' and remove it from the current workbook.
    wsDest.Move
    
    ' Grab a reference to the new workbook.
    With Workbooks
        Set wbDest = .Item(.Count)
    End With
    
    ' Save new workbook as text file & close.
    Application.DisplayAlerts = False
    wbDest.SaveAs fileName, xlTextWindows
    wbDest.Close False
    Application.DisplayAlerts = True

End Sub

Answer 2

Export Column to Textfile

Sub FileNameAsCellContent()

    Dim Path As String
    Dim FileName As String
    
    Path = "C:\temp\"
    FileName = Range("E5").Value & ".txt"
    
    Application.ScreenUpdating = False

    Columns("S").Copy
    With Workbooks.Add
        .Worksheets(1).Columns("A").PasteSpecial
        Application.DisplayAlerts = False
        .SaveAs Path & FileName, xlTextWindows
        .Close False
        Application.DisplayAlerts = True
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Export Complete.  Click OK to continue"

End Sub

Answer 3

Using a TextStream Object

Option Explicit

Sub Export()

    Const SHT_NAME = "Customer_Class_Clean-Up_Report"
    Const RNG_NAME = "H7" ' cell
    Const TABLENAME = "Table_Query_from_CHECKMATE"
    Const COL = "Yard,AccountNum,CustomerCategory"
    Const FOLDER = "C:\temp\"
    
    Dim ws As Worksheet, rng As Range, cell As Range
    Dim filename As String, n As Long
    Dim FSO As Object, ts As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' build export filename
    Set ws = ThisWorkbook.Sheets(SHT_NAME)
    filename = FOLDER & ws.Range(RNG_NAME).Value
    If Len(filename) = 0 Then
       MsgBox "Filename is blank", vbCritical
       Exit Sub
    End If
    filename = filename & ".txt"

    ' create text file
    Set ts = FSO.createTextfile(filename, True, True) 'overwrite, unicode
    Set rng = ws.Range(TABLENAME & "[[#Headers],[" & COL & "]]")
    For Each cell In ws.Range(rng, rng.End(xlDown))
        ts.writeline cell
        n = n + 1
    Next

    ' finish
    ts.Close
    MsgBox n & " Rows exported from " & rng.Address & vbCrLf & _
           " to " & filename, vbInformation, "Click OK to continue."

End Sub

Answer 4

I used the following and it will work for what I need. It's copying the table content that I need, pasting it in a sheet called "ForExport" and then saving the content in that worksheet with the file name I need.

Sub Export()

Application.ScreenUpdating = False

Sheets("ForExport").Visible = True

Sheets("ForExport").Select
    
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft

Sheets("Customer_Class_Clean-Up_Report").Select

Range( _
        "Table_Query_from_CHECKMATE[[#Headers],[Yard,AccountNum,CustomerCategory]]"). _
        Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("ForExport").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select

Sheets("ForExport").Select

Dim FileName As String
Dim Path As String

Sheets("Customer_Class_Clean-Up_Report").Select

Path = "C:\temp\"
FileName = Range("H7").Value & ".txt"

Sheets("ForExport").Select

ActiveWorkbook.SaveAs Path & FileName, xlTextPrinter
'ActiveWorkbook.Close SaveChanges:=True

Sheets("Customer_Class_Clean-Up_Report").Select
Range("B5").Select

MsgBox "Export complete.  File is located in the C:\temp directory.  Click OK to continue."

End Sub