Excel VBA複製查詢將表單中的數據複製到文本文件

Question

我有一個小代碼，它可以從工作表中複製行1-300中的所有文本，然後將其保存爲UTF-8格式的文本文件。我希望它展開，所以它只從文本行復制文本。我不是VBA的人，請幫助我。

Sub tgr() 

Dim oStream As Object 
Dim sTextPath As String 
Dim sText As String 
Dim rIndex As Long, cIndex As Long 

sTextPath = Application.GetSaveAsFilename("import.txt", "Text Files, *.txt") 
If sTextPath = "False" Then Exit Sub 

For rIndex = 1 To 300 
    If rIndex > 1 Then sText = sText & vbNewLine 
    For cIndex = 1 To Columns("BC").Column 
    If cIndex > 1 Then sText = sText & vbTab 
    sText = sText & Sheets("IMPORT-SHEET").Cells(rIndex, cIndex).Text 
    Next cIndex 
Next rIndex 

Set oStream = CreateObject("ADODB.Stream") 
With oStream 
    .Type = 2 
    .Charset = "UTF-8" 
    .Open 
    .WriteText sText 
    .SaveToFile sTextPath, 2 
    .Close 
End With 

Set oStream = Nothing 

End Sub 

Answer 1

試試這個，它應該有希望排除在沒有文字的所有行。

Sub tgr() 

Dim oStream As Object 
Dim sTextPath As String 
Dim sText As String 
Dim sLine As String 
Dim rIndex As Long, cIndex As Long 

sTextPath = Application.GetSaveAsFilename("import.txt", "Text Files, *.txt") 
If sTextPath = "False" Then Exit Sub 

sText = "" 

For rIndex = 1 To 300 
    sLine = "" 
    For cIndex = 1 To Columns("BC").Column 
    If cIndex > 1 Then 
     sLine = sLine & vbTab 
    End If 
    sLine = sLine & Sheets("IMPORT-SHEET").Cells(rIndex, cIndex).Text 
    Next cIndex 
    If Not Len(Trim(Replace(sLine, vbTab, ""))) = 0 Then 
    If rIndex > 1 Then 
     sText = sText & vbNewLine & sLine 
    End If 
    End If 
Next rIndex 

Set oStream = CreateObject("ADODB.Stream") 
With oStream 
    .Type = 2 
    .Charset = "UTF-8" 
    .Open 
    .WriteText sText 
    .SaveToFile sTextPath, 2 
    .Close 
End With 

Set oStream = Nothing 

End Sub