Question

这是一个与以下问题相关的问题：Create text Files from every row in an Excel spreadsheet我使用以下代码实现了ExactaBox的优秀解决方案：

Sub SaveRowsAsENW()

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long

    Set wsSource = ThisWorkbook.Worksheets("worksheet1")

    Application.DisplayAlerts = False 'will overwrite existing files without asking

    r = 1
    Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
        ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
        Set wsTemp = ThisWorkbook.Worksheets(1)

        For c = 2 To 7
            wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
        Next c

        wsTemp.Move
        Set wbNew = ActiveWorkbook
        Set wsTemp = wbNew.Worksheets(1)
        'wbNew.SaveAs wsSource.Cells(r, 1).Value & ".csv", xlCSV 'old way
        wbNew.SaveAs "textfile" & r & ".enw", xlCSV 'new way
        'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx
        wbNew.Close
        ThisWorkbook.Activate
        r = r + 1
    Loop

    Application.DisplayAlerts = True

End Sub
Option Explicit

我使用过此解决方案，效果很好。我唯一的麻烦是有些行在输出文件中得到引号。

这是输出文本文件的示例（第2-3行演示了错误）：

0  Journal Article 'No quotation marks
"%A  Wofford, J.C."
"%A  Goodwin, Vicki L."
%T  A field study of a cognitive approach to understanding transformational and .. 'No quotation marks

这种格式似乎在保存时添加（它不是单元格格式的一部分）。你们有没有想过为什么会这样？ /我如何调整我的代码来修复它？

Answer 1

真。 .csv代表以逗号分隔的值，其中字段包含必须“转义”的逗号（此处带引号）或在每个逗号之前/之后拆分为不同的字段。之前提供的答案确实提供了替代方案 - 其中制表符分隔是最符合逻辑的。

Answer 2

这可能已经超出了对你有所帮助的程度，但是在我最近遇到这个问题后，我想我会分享我最终的解决方案。您看到的格式实际上是MS保存问题的结果，该问题会将引号附加到具有特定字符的行。

在我的情况下，我像往常一样写出文件，然后调用一个sub来清除问题额外字符的文件。首先，我替换了任何需要引号的输出，例如星号或我文件中永远不会出现的任何其他字符。然后我正常保存文件并调用下面的代码，用于将任何字符替换为另一个字符，两次。一旦删除Excel创建的引号，第二次用引号替换我的虚拟字符。代码执行得相当快，并重命名文件，以便您可以确定结果已完成处理。希望对其他人有用。

由于您保存文件然后进行编辑，它仍然比我想要的更笨，但它最终能够成为我的最终解决方案。

    Sub ReplaceStringInTextFile(FileNameAndLoc As String, OutFile As String, SearchForWords As String, SubstituteWords As String)
        'This macro searches a file, replacing one string with another, saving it, and renaming it.
        Dim objFSO As Object
        Dim objReadFile As Object
        Dim objWriteFile As Object

        'Set Objects
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objReadFile = objFSO.opentextfile(FileNameAndLoc, 1, False)

        'Read file contents
        Contents = objReadFile.readall

        'Close read file
        objReadFile.Close

        'Copy contents without double quotes
        NewContents = Replace(Contents, SearchForWords, SubstituteWords)

        'Write output
        Set objWriteFile = objFSO.opentextfile(FileNameAndLoc, 2, False)
        objWriteFile.write NewContents
        objWriteFile.Close

        'Rename file
        Name FileNameAndLoc As OutFile
    End Sub

从工作表中另存为文本文件时格式化错误

2 个答案: