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

Question

我有一个带有表格的 Excel 报告，我需要将该表格中的单个列导出到 txt 文件。 我正在根据电子表格中的字段计算要用于 txt 文件的文件名，因此我想将该字段用作我的文件名。

我要导出的数据在 S 列中。

我要使用的文件名在单元格 E5 中，并且还包含 txt 的文件扩展名。

这是我到目前为止所拥有的：

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

这可行，但它正在导出整个工作表，我只需要表格中的一列。

Answer 1

该子程序会将 Sheet1、S 列中的数据保存到文本文件中。

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

将列导出到文本文件

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

使用文本流 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

我使用了以下内容，它将满足我的需要。 它正在复制我需要的表格内容，将其粘贴到名为“ForExport”的工作表中，然后使用我需要的文件名将内容保存在该工作表中。

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