Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Dim c As Range
Dim filename As Variant
Dim colcount As Integer
colcount = 2
Worksheets("ShipmentTracker(AL3)").Activate
filename = InputBox("Enter File Name", "file name", Worksheets("ShipmentTracker(AL3)").Cells(3, 2).Value)
Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile("C:\Users\soora\Desktop\Meng Project\Shipment Tracker" & filename, ForAppending, True)
For Each c In Range("A9", Range("A9").End(xlDown))
For i = 1 To colcount
ts.Write c.Offset(0, i - 1).Value
If i < colcount Then ts.Write vbTab
Next i
ts.WriteLine
Next c
ts.Close
Set fso = Nothing
我将 filename
作为输入并使用它来创建我想要写入数据的新文件。但这不起作用。
我想创建包含用户输入 filename
的文件并向其写入数据。
答案 0 :(得分:0)
尝试使用Environ
Option Explicit
Sub TEST()
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Dim c As Range
Dim I As Long
Dim filename As Variant
Dim colcount As Integer
Dim sPath As String
Application.ScreenUpdating = False
'// SaveAs Path
sPath = Environ("USERPROFILE") & "\Desktop\Meng Project\Shipment Tracker\"
colcount = 2
Worksheets("ShipmentTracker(AL3)").Activate
filename = InputBox("Enter File Name", "file name", _
Worksheets("ShipmentTracker(AL3)").Cells(3, 2).Value)
Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile(sPath & filename, ForAppending, True)
For Each c In Range("A9", Range("A9").End(xlDown))
For I = 1 To colcount
ts.Write c.Offset(0, I - 1).Value
If I < colcount Then ts.Write vbTab
Next I
ts.WriteLine
Next c
Application.ScreenUpdating = True
ts.Close
Set fso = Nothing
End Sub