MS Excel VB將數據導出到文本文件

Question

有沒有一種方法可以在Windows中使用Excel宏來執行以下操作：

1. 使用值或單元格內容（例如A1創建.txt文件名。 它可以是字母數字。
2. 然后從范圍列B獲取Excel數據，其中行數有所不同。 應該只獲取數據，而不是B列的空行。
3. 將文本文件保存在桌面上，顯示保存文件確切位置的消息。
4. 現在，保存宏后，如果再次使用相同的文本文件名運行宏，則應在名稱相同的情況下替換之前的文件。
5. 宏從同一工作簿中的另一個工作表運行，而不是從包含數據的工作表運行。 說“宏”來自sheet1 ，數據位於sheet2 ，數據包含單引號，雙引號和“管道”，這在導出時不會受到影響。
6. 並在導出后清除剪貼板，如以下代碼所示。

請提出建議。

Sub Export() 
    Dim rc As Variant 
    Dim s As String 

    s = ActiveWorkbook.Path & "\Hello World.txt" 
    Range("B:B").Copy 

    MakeTXTFile s 

    rc = Shell("notepad " & s, 1) 
    Kill s 
End Sub 

Sub MakeTXTFile(filePath As String, str As String) 
    Dim hFile As Integer 
    If Dir(FolderPart(filePath), vbDirectory) = "" Then 
        MsgBox filePath, vbCritical, "Missing Folder" 
        Exit Sub 
    End If 

    hFile = FreeFile 
    Open filePath For Output As #hFile 
    If str <> "" Then Print #hFile, str 
    Close hFile 
End Sub 

Function FolderPart(sPath As String) As String 
    FolderPart = Left(sPath, InStrRev(sPath, "\")) 
End Function 


Function getClipboard() 
     'Add Reference:   'Reference: Microsoft Forms xx Object
    Dim MyData As DataObject 

    On Error Resume Next 
    Set MyData = New DataObject 
    MyData.GetFromClipboard 
    getClipboard = MyData.GetText 
End Functionb

我用上面的代碼。

Answer 1

代碼應該是這樣的：

Sub Export()
Dim rc As Variant
Dim s As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object

If (ActiveSheet.Name <> "Sheet1") Then
    MsgBox ("Error: Wrong Sheet")
    Exit Sub
End If

s = MyDocs & "\" & Range("A1").Value & ".txt"
Set oFile = fso.CreateTextFile(s)

For Each xx In Range("B:B")
    If xx.Value <> "" Then oFile.WriteLine xx
Next
oFile.Close
Set fso = Nothing
Set oFile = Nothing

MsgBox ("Saved in: " & s)

rc = Shell("notepad " & s, 1)
'    Kill s
End Sub

不清楚要點6。我放了一張支票，里面可以放你想要的東西...
在此代碼中，不檢查文件名
嘗試使用OLD方法...

Dim rc As Variant
Dim s As String
Dim xx

If (ActiveSheet.Name <> "Sheet1") Then
    MsgBox ("Error: Wrong Sheet")
    Exit Sub
End If

s = MyDocs & "\" & Range("A1").Value & ".txt"
Open s For Output As #1
For Each xx In Range("B:B")
    If xx.Value <> "" Then Print #1, xx
Next
Close #1

MsgBox ("Saved in: " & s)
rc = Shell("notepad " & s, 1)