如何将文件名作为输入在VBA中创建文件

时间:2016-01-19 01:12:03

标签: excel vba excel-vba

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 的文件并向其写入数据。

1 个答案:

答案 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

MSDN Environ Function