将Excel工作表保存为不带自动双引号分隔符的制表符分隔文本文件
我正在编写一个macros，将文本文件下载到Excel中，过滤掉不必要的数据，并在本地保存修改的文本文件。
一切正常，但是本地编写的文件引用了某些文本，我认为这与可能被看作是分隔符的逗号有关，是这样的，如果是这样的话，代码如下？
注意：我有一个运行GetHtmlTable和KillLoop过程的button。
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:\Users\Speedy\Desktop\Test\test.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 这里最好的select是使用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:\Users\Speedy\Desktop\Test\test.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