VBA 复制文件 并修改文件

使用VBA复制文件的5个实战示例

FileSystemObject.CopyFile "c:\mydocuments\letters\sample.doc", "c:\tempfolder\sample_new.doc"

Sub 按钮1_Click()

Set wk = ThisWorkbook.Worksheets("Sheet1")

'Workbooks("").Worksheets

Path = wk.Range("C12")

afterPath = wk.Range("C14")

' 复制文件夹
Call CopyFiles(Path, afterPath)

afterPath = wk.Range("C15")

Call CopyFiles2(Path, afterPath)

 Dim wkbk As Workbook  '定义一个工作薄

 Set fso = CreateObject("Scripting.FileSystemObject")
 
 Set targetFolder = fso.GetFolder(afterPath)
    
    ' 遍历源文件夹中的所有文件
    For Each file In targetFolder.Files
    
    Debug.Print file.Path
    
    If file.Path Like "*テーブル*" Then
    
     Set wkbk = Workbooks.Open(file.Path) '先打开要复制的文件
    
     wkbk.Activate '激活打开工作簿
     
     wkbk.Worksheets("辞書").Activate
     
     wkbk.Worksheets("辞書").Range("M14").Value = "ddd"
     
     wkbk.Save
    
     
     wkbk.Close False '关闭工作薄
     
     End If

    Next file
 
 
End Sub

Sub CopyFiles(ByVal Path As String, afterPath)
    'Path：原文件夹路径；afterPath：目标文件夹路径
    Dim Spath As String
    '设置文件对象
    Set fs = CreateObject("Scripting.FileSystemObject")
    '拿到文件夹名
    Spath = Dir(Path, vbDirectory)
    '判断文件夹
    Do While Len(Spath)
    
        Debug.Print Spath
        '判断文件夹不为当前文件夹和其父文件夹
        If Spath <> "." And Spath <> ".." Then
            '复制文件夹下的所有文件
            fs.CopyFolder Path, afterPath
            '下一个文件夹
            Spath = Dir()
        End If
    Loop
End Sub

Sub CopyFiles2(ByVal Path As String, afterPath)
    Dim fso As Object
    Dim sourceFolder As Object
    Dim targetFolder As Object
    Dim file As Object
    
    ' 创建FileSystemObject对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    
     If Not fso.FolderExists(Path) Then
        MsgBox "目标文件不存在"
           Exit Sub
        
    End If
    
     If Not fso.FolderExists(afterPath) Then
        fso.CreateFolder afterPath
        
        Else
        msgBoxAnswer = MsgBox(Prompt:="目标位置文件已经存在." & vbNewLine & _
        "你想覆盖掉吗?", Buttons:=vbYesNo, Title:="复制文件")
 
       If msgBoxAnswer = vbNo Then
          Exit Sub
        End If
    End If
    
    ' 获取源文件夹的引用
    Set sourceFolder = fso.GetFolder(Path)
    
    
    ' 获取目标文件夹的引用
    Set targetFolder = fso.GetFolder(afterPath)
    
    ' 遍历源文件夹中的所有文件
    For Each file In sourceFolder.Files
    
     Debug.Print file.Path
        ' 复制文件到目标文件夹
        fso.CopyFile file.Path, targetFolder.Path & "\" & file.Name
        
        ' 如果需要，可以使用以下代码移动源文件到另一个文件夹
        ' fso.MoveFile file.Path, "C:\BackupFolder\" & file.Name
    Next file
    
    ' 释放对象
    Set file = Nothing
    Set targetFolder = Nothing
    Set sourceFolder = Nothing
    Set fso = Nothing
End Sub