根据 C 列的内容从 D 列提取文本到 txt 文件和命名文件

Question

为一个菜鸟问题道歉，但我一直在摆弄这段代码： https://stackoverflow.com/a/7151963/3672159 并且似乎无法对其进行修改以执行以下操作（对上面的代码进行了非常轻微的修改）：

1. 将名为“Export Data”的工作表作为输入（而不是现有代码中的“Sheet1”；该空间似乎会导致问题）
2. 自动为 D 列的每个单元格创建一个空文件，其内容应包含相应 D 单元格的值（与上面代码中的“免责声明”数据相同）
3. 根据相应 C 单元格的值命名每个文件（因此对我来说，它是 name=column C, content=column D 而不是原始代码中的 B 和 A）。

我将代码修改如下：

Sub ExportFiles()
Dim sExportFolder, sFN
Dim rStoreId As Range
Dim rAbstract As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object

'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "my file path\txt"
Set oSh = Export Data

Set oFS = CreateObject("Scripting.Filesystemobject")

For Each rStoreId In oSh.UsedRange.Columns("D").Cells
    Set rAbstract = rStoreId.Offset(, -1)

    'Add .txt to the article name as a file name
    sFN = rStoreId.Value & ".txt"
    Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
    oTxt.Write rAbstract.Value
    oTxt.Close
  Next
End Sub

这样做的唯一一件事（与原始代码一样）是创建一个空的未命名的 txt 文件。 非常感谢任何帮助！

Answer 1

试试这个...

Sub ExportFiles()
Dim sExportFolder, sFN
Dim rStoreId As Range
Dim rAbstract As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object

'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "C:\Users\Rich\Desktop"
Set oSh = ThisWorkbook.Sheets("Export Data")


Set oFS = CreateObject("Scripting.Filesystemobject")

For Each rStoreId In oSh.Columns("D").Cells

    If IsEmpty(rStoreId.Value) Then
        Exit For
    End If

    Set rAbstract = rStoreId.Offset(, -1)

    'Add .txt to the article name as a file name
    sFN = rStoreId.Value & ".txt"
    Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
    oTxt.Write rAbstract.Value
    oTxt.Close
  Next
End Sub

您需要正确选择工作表（假设它与代码在同一个工作簿中）...

Set oSh = ThisWorkbook.Sheets("Export Data")

我改变了你遍历范围的方式......

For Each rStoreId In oSh.Columns("D").Cells

    If IsEmpty(rStoreId.Value) Then
        Exit For
    End If

Next

这只是通过 D 列的单元格，直到它碰到一个空的单元格，我无法使用 UsedRange 让它工作，而这个（更旧的 skool）方法在我的测试中有效。

Answer 2

这对我有用。它将 D 列中单元格中的每个值写入基于 C 列中的条目命名的文本文件，并将所有文本文件放在用户指定的文件夹中：

Sub ExportFiles()
    Dim exportFolder As String
    Dim fso As FileSystemObject
    Dim stream As TextStream
    Dim cl As Range

    exportFolder = "C:\User\ExportFolder"  //Add you folder path here
    Set fso = New FileSystemObject

        For Each cl In Worksheets("Export Data").UsedRange.Columns("D").Cells
            Set stream = fso.CreateTextFile(filepath & "\" & cl.Offset(0, -1).Value & ".txt", 2, True)
            stream.Write cl.Value
            stream.Close
        Next
End Sub