Question

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

将名为＆＃34;导出数据＆＃34;的工作表作为输入。（而不是＆＃34; Sheet1＆＃34;就像在现有代码中一样;空间似乎会导致问题）
自动为D列的每个单元格创建一个空文件，该文件的内容应为相应D单元格的值（与＆＃34;免责声明＆＃34;上述代码中的数据相同）
根据相应C单元格的值命名每个文件（因此对我来说，它的名称= C列，内容= 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

这对我有用。它将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

Answer 2

试试这个......

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）方法在我的测试中有效。

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

2 个答案: