另外新增文字檔,然後將資料寫入,謝謝。
Sub test()
Dim fs As Object, a As Object, R As Range
Application.ScreenUpdating = False
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("D:\" & 1 & ".txt")
For Each R In [A2:A32]
a.WriteLine (R)
Next
a.Close
Application.ScreenUpdating = True
End Sub作者: zz0660 時間: 2021-11-3 14:11
Sub test1()
Dim fs, f, R As Range, fc%, x%
Application.ScreenUpdating = False
Set fs = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "D:\"
.AllowMultiSelect = True
.Show
fc = .SelectedItems.Count
If fc = 0 Then Exit Sub
For x = 1 To fc
FPath = .SelectedItems(x)
Set f = fs.OpenTextFile(FPath, 2) '8:保留原資料;2:清除原資料
For Each R In [A2:A32]: f.WriteLine (R): Next
f.Close
Next
End With
Set fs = Nothing: Set f = Nothing
Application.ScreenUpdating = True
End Sub作者: quickfixer 時間: 2021-11-3 16:55