vba 操作文件夹和txt文件

使用VBA的MkDir语句创建文件夹。

代码如下：

Sub xyf()

    On Error Resume Next

    VBA.MkDir ("c:/例子")

End Sub

使用FileSystemObject对象的CreateFolder方法。

代码如下：

Sub xyf()

    On Error Resume Next

    Dim oFso

    Set oFso = CreateObject("Scripting.FileSystemObject")

    oFso.CreateFolder ("C:/例子")

End Sub

Pth =ThisWorkbook.Path & "\" & Format(Now(), "所有清单(更新日期-yyyy年m月d日H时N分)\")

mkdir pth

剪切文件：

Sub movef()
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.movefile "D:\我的文档\源文件夹\文档.txt", "D:\我的文档\目标文件夹\文档.txt"
End Sub

复制文件：

Sub 复制当前路径的所有文件到指定文件夹_FileCopy()

    t = Timer

    Dim 当前路径 As String, 目标路径 As String

    Dim fs

    On Error Resume Next

    当前路径 = ThisWorkbook.Path & "\"

    目标路径 = "C:\汇总数据\"   '目标目录

    fs = Dir(当前路径 & "*")    '如果只复制xls则把 "*" 改成 "*.xls")

    Do While fs <> ""

        FileCopy 当前路径 & fs, 目标路径 & fs

        fs = Dir

    Loop

    ActiveWorkbook.SaveCopyAs 目标路径 & ThisWorkbook.Name

    '*******如果想要对一个已打开的文件使用 FileCopy 语句，则会产生错误******

    MsgBox Format(Timer - t, "0.0000")

End Sub

实例：

Sub test()

    Dim arr, arrTemp

    Dim strPath As String

    Dim strTemp

    Dim i As Long, j As Long

    On Error Resume Next

    strPath = ThisWorkbook.Path & Application.PathSeparator

    arr = Sheet1.Range("a1").CurrentRegion

    For i = LBound(arr) + 1 To UBound(arr)

        strTemp = strPath

        arrTemp = Split(arr(i, 1), "\")

        For j = LBound(arrTemp) To UBound(arrTemp)

            strTemp = strTemp & arrTemp(j) & Application.PathSeparator

            MkDir strTemp

        Next

    Next

End Sub

txt文件实例：

Private Sub CommandButton1_Click()

    Dim fs As New FileSystemObject

    Application.ScreenUpdating = False

    For i = 2 To [a65536].End(xlUp).Row

        Set fs = CreateObject("Scripting.FileSystemObject")

        If Not fs.FolderExists(ThisWorkbook.Path & "\" & Split(Cells(i, 1), "-")(1)) Then fs.CreateFolder (ThisWorkbook.Path & "\" & Split(Cells(i, 1), "-")(1))

        If Not fs.FolderExists(ThisWorkbook.Path & "\" & Split(Cells(i, 1), "-")(1) & "\" & Cells(i, 3)) Then fs.CreateFolder (ThisWorkbook.Path & "\" & Split(Cells(i, 1), "-")(1) & "\" & Cells(i, 3))

        Set a = fs.CreateTextFile(ThisWorkbook.Path & "\" & Split(Cells(i, 1), "-")(1) & "\" & Cells(i, 3) & "\" & Cells(i, 1) & ".txt", True)

        a.WriteLine (Cells.Item(1, 4) & Cells(i, 4))

        a.WriteLine (Cells.Item(1, 5) & Cells(i, 5))

        a.WriteLine (Cells.Item(1, 6) & Cells(i, 6))

        a.WriteLine (Cells.Item(1, 3) & Cells(i, 7))

        a.Close

    Next

    Application.ScreenUpdating = True

    MsgBox "OK"

End Sub