将 Excel 工作表另存为制表符分隔的文本文件，而不使用自动双引号分隔符

Question

我正在编写一个宏来将文本文件下载到Excel中，过滤掉不必要的数据并将修改后的文本文件保存在本地。

一切正常，但本地编写的文件在某些文本周围有引号 （"）。我认为这可能与逗号被视为分隔符有关。是这种情况吗，如果是这样，我的代码下面是否有解决方法？

注意：我有一个运行GetHtmlTable和KillLoop过程的按钮。

Option Explicit
Public StopLoop As Boolean
Sub GetHtmlTable()
StopLoop = False
Do Until StopLoop = True
DoEvents
    Dim objWeb As QueryTable
    Sheets(1).Columns(1).ClearContents
    With Sheets("Sheet1")
        Set objWeb = .QueryTables.Add( _
        Connection:="URL;http://www.spotternetwork.org/feeds/gr.txt", _
        Destination:=.Range("A1"))
        With objWeb
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "1" ' Identify your HTML Table here
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
    End With
    Set objWeb = Nothing

'End Import of Text From http://www.spotternetwork.org/feeds/gr.txt==================
'Start Filter Out Unused Data========================================================
Dim i As Long
Dim j As Long
Dim LRow As Long
Dim LListRow As Long
Dim BMatch As Boolean
'Find last instance of "End:" in
LRow = Sheets(1).Range("A:A").Find(what:="End*", searchdirection:=xlPrevious).Row
'Find last non-blank row in column A of second sheet
LListRow = Sheets(2).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.EnableEvents = False
If LRow >= 11 Then
    'Make sure there are at least 11 rows of data
    i = LRow
    'MsgBox "First checkpoint: Last row of data is " & LRow 'Comment out this line
    Do
        BMatch = False
        For j = 1 To LListRow
            'Test this block to see if the value from j appears in the second row of data
            If InStr(1, Sheets(1).Range("A" & i - 2).Value2, Sheets(2).Range("A" & j).Value2) > 0 Then
                BMatch = True
                Exit For
            End If
        Next j
        'Application.StatusBar = "Match status for row " & i & ": " & BMatch
        If Not BMatch Then
            'Loop backwards to find the starting row (no lower than 11)
            For j = i To 11 Step -1
                If Sheets(1).Range("A" & j).Value2 Like "Object:*" Then Exit For
            Next j
            Sheets(1).Rows(j & ":" & i).Delete
            i = j - 1
        Else
            'Find next block
            If i > 11 Then
                For j = i - 1 To 11 Step -1
                    If Sheets(1).Range("A" & j).Value2 Like "End:*" Then Exit For
                Next j
                i = j
            Else
                i = 10 'Force the loop to exit
            End If
        End If
        'Application.StatusBar = "Moving to row " & i
    Loop Until i < 11
    'Loop back through and delete any blank rows
    LRow = Sheets(1).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
    'MsgBox "Second checkpoint: new last row of data is " & LRow
    For i = LRow To 11 Step -1
        If Sheets(1).Range("A" & i).Value2 = vbNullString Then Sheets(1).Rows(i).Delete
    Next i
End If
'Application.StatusBar = False
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'End Filter Out Unused Data========================================================
'Start Write To Local Txt File=====================================================
Dim sSaveAsFilePath As String
Application.DisplayAlerts = False

    sSaveAsFilePath = "C:UsersSpeedyDesktopTesttest.txt"
    Sheets(1).Copy '//Copy sheet 1 to new workbook
    ActiveWorkbook.SaveAs sSaveAsFilePath, xlTextWindows '//Save as text (tab delimited) file
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then '//Double sure we don't close this workbook
        ActiveWorkbook.Close False
    End If
Application.DisplayAlerts = True
Application.Wait (Now + TimeValue("0:00:05"))
Loop
End Sub
Sub KillMacro()
  StopLoop = True ' stop that perpetual loop in Workbook_Open()
  MsgBox "Program Stopped"
End Sub

Answer 1

最好的办法是使用 VBA 将数据写入文本文件，而不是将工作簿另存为文本文件。

请考虑以下修改后的代码：

Option Explicit
Public StopLoop As Boolean
Sub GetHtmlTable()
StopLoop = False
Do Until StopLoop = True
    DoEvents
    Dim objWeb As QueryTable
    Sheets(1).Columns(1).ClearContents
    With Sheets("Sheet1")
        Set objWeb = .QueryTables.Add( _
        Connection:="URL;http://www.spotternetwork.org/feeds/gr.txt", _
        Destination:=.Range("A1"))
        With objWeb
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "1" ' Identify your HTML Table here
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
    End With
    Set objWeb = Nothing

    'End Import of Text From http://www.spotternetwork.org/feeds/gr.txt==================
    'Start Filter Out Unused Data========================================================
    Dim i As Long
    Dim j As Long
    Dim LRow As Long
    Dim LListRow As Long
    Dim BMatch As Boolean
    'Find last instance of "End:" in
    LRow = Sheets(1).Range("A:A").Find(what:="End*", searchdirection:=xlPrevious).Row
    'Find last non-blank row in column A of second sheet
    LListRow = Sheets(2).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    If LRow >= 11 Then
        'Make sure there are at least 11 rows of data
        i = LRow
        'MsgBox "First checkpoint: Last row of data is " & LRow 'Comment out this line
        Do
            BMatch = False
            For j = 1 To LListRow
                'Test this block to see if the value from j appears in the second row of data
                If InStr(1, Sheets(1).Range("A" & i - 2).Value2, Sheets(2).Range("A" & j).Value2) > 0 Then
                    BMatch = True
                    Exit For
                End If
            Next j
            'Application.StatusBar = "Match status for row " & i & ": " & BMatch
            If Not BMatch Then
                'Loop backwards to find the starting row (no lower than 11)
                For j = i To 11 Step -1
                    If Sheets(1).Range("A" & j).Value2 Like "Object:*" Then Exit For
                Next j
                Sheets(1).Rows(j & ":" & i).Delete
                i = j - 1
            Else
                'Find next block
                If i > 11 Then
                    For j = i - 1 To 11 Step -1
                        If Sheets(1).Range("A" & j).Value2 Like "End:*" Then Exit For
                    Next j
                    i = j
                Else
                    i = 10 'Force the loop to exit
                End If
            End If
            'Application.StatusBar = "Moving to row " & i
        Loop Until i < 11
        'Loop back through and delete any blank rows
        LRow = Sheets(1).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
        'MsgBox "Second checkpoint: new last row of data is " & LRow
        For i = LRow To 11 Step -1
            If Sheets(1).Range("A" & i).Value2 = vbNullString Then Sheets(1).Rows(i).Delete
        Next i
    End If
    'Application.StatusBar = False
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    'End Filter Out Unused Data========================================================
    'Start Write To Local Txt File=====================================================
    Dim sSaveAsFilePath As String
    Application.DisplayAlerts = False

    sSaveAsFilePath = "C:UsersSpeedyDesktopTesttest.txt"
    'Delete file if it exists
    On Error Resume Next
    Kill sSaveAsFilePath
    On Error GoTo 0
    'Open file for writing
    LRow = Sheets(1).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
    Dim iFile As Integer
    iFile = FreeFile()
    Open sSaveAsFilePath For Output As #iFile
    For i = 1 To LRow
        Print #iFile, Sheets(1).Range("A" & i).Value2
    Next i
    Close #iFile
    Application.DisplayAlerts = True
    Application.Wait (Now + TimeValue("0:00:05")) 'Uncomment this line
Loop
End Sub
Sub KillMacro()
  StopLoop = True ' stop that perpetual loop in Workbook_Open()
  MsgBox "Program Stopped"
End Sub