我有一个带有表格的 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
这可行，但它正在导出整个工作表，我只需要表格中的一列。
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
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
该子程序会将 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
我使用了以下内容，它将满足我的需要。它正在复制我需要的表格内容，将其粘贴到名为“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