删除XML文件中的额外引号

I'm making a quick and dirty XML generator. The below code works well but when I open it it has additional double quotes i.e. <"something"> will turn into "<""something"">. Is there a way to remove them with the below code? I can't use xlTextPrinter because some of the cells have more than 255 characters. Any help will be very much appreciated!

我正在制作一个快速而又脏的XML生成器。下面的代码效果很好但是当我打开它时它有额外的双引号,即<“something”>将变成“<”“something”“>。有没有办法用下面的代码删除它们?我不能使用xlTextPrinter因为一些单元格超过255个字符。非常感谢任何帮助!

Sub test()
    Dim Desktop As String
    Dim FileName As String
    Desktop = CreateObject("Wscript.Shell").Specialfolders("Desktop")
    With ActiveSheet
        FileName = .Range("B1").Value
        .Range("H2:K33").Copy
        Workbooks.Add
        ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
    With ActiveWorkbook
        .SaveAs FileName:=Desktop & Application.PathSeparator & FileName  _
            , FileFormat:=xlTextMSDOS, CreateBackup:=False
        .Close SaveChanges:=False
    End With
End Sub

1 个解决方案

#1

Because excel will add quotes to a file in certain situations when exported as text you have a couple options.

因为在导出为文本时,excel会在某些情况下为文件添加引号,因此您有两个选项。

Chr(9) is tab

选项卡(9)是标签

Chr(34) is quote

Chr(34)是引用

vbCrLf is a new line character

vbCrLf是一个新行字符

Instead of saving your file you could write it to text directly:

您可以直接将文件写入文本,而不是保存文件:

Dim Desktop As String
Dim FileName As String
Dim fs As Object
Dim f As Object
Dim i As Integer

Set fs = CreateObject("Scripting.FileSystemObject")

Desktop = CreateObject("Wscript.Shell").Specialfolders("Desktop")
With ActiveSheet
    FileName = Desktop & Application.PathSeparator & .Range("B1").Value
    Set f = fs.createTextFile(FileName & ".txt", True, False)

    For i = 2 To 33
        f.write (.Cells(i, 8) & Chr(9) & .Cells(i, 9) & Chr(9) & .Cells(i, 10) & Chr(9) & .Cells(i, 11) & vbCrLf)
    Next

    f.Close
    Set f = Nothing
    Set fs = Nothing
End With

Or like Siddarth Rout suggested you can open the file after creating it and replace the additional quotes that it adds:

或者像Siddarth Rout建议您在创建文件后打开文件并替换它添加的其他引号:

Dim Desktop As String
Dim FileName As String
Desktop = CreateObject("Wscript.Shell").Specialfolders("Desktop")
With ActiveSheet
    FileName = Desktop & Application.PathSeparator & .Range("B1").Value
    .Range("H2:K33").Copy
    Workbooks.Add
    ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With
With ActiveWorkbook
    .SaveAs FileName:=FileName _
        , FileFormat:=xlTextMSDOS, CreateBackup:=False
    .Close SaveChanges:=False
End With

Dim fs As Object
Dim f As Object
Dim content As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(FileName & ".txt", 1, -2)

content = f.readall

f.Close

content = Replace(content, Chr(34) & "<", "<")
content = Replace(content, ">" & Chr(34), ">")
content = Replace(content, Chr(34) & Chr(34), Chr(34))

Set f = fs.createTextFile(FileName & ".txt", True, False)

f.write (content)

f.Close
Set f = Nothing
Set fs = Nothing

#1