VBA模板记录

路径相关

获取当前工作簿路径

Application.ActiveWorkbook.Path '路径本身(不带工作簿名称)
Application.ActiveWorkbook.FullName '用于具有工作簿名称的路径。

文件夹相关

复制文件夹下所有内容到另一个文件夹

Sub copy_folder(byval sourceFolder As String, _
byval destinationFolder As String)

    Dim fso As Object
    
    ' 创建 FileSystemObject 对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 调用 CopyFolder 方法进行复制
    On Error Resume Next
    fso.CopyFolder sourceFolder, destinationFolder, True ' True 表示允许覆盖
    If Err.Number <> 0 Then
        MsgBox "复制失败: " & Err.Description, vbExclamation, "错误"
        Err.Clear
    Else
        MsgBox "文件夹复制成功!", vbInformation, "完成"
    End If
    
    ' 释放对象
    Set fso = Nothing
End Sub

文件夹若存在则删除后新建,否则直接新建

Sub remove_and_make_folder(byval folder_path as string)
    Dim resFolder
    resFolder = Dir(folder_path, vbDirectory)   '判断路径为"D:\changeAfter_Files"的文件夹是否存在
    '如果不存在,就新建一个
    If resFolder = "" Then
        MkDir folder_path '("D:\changeAfter_Files")
    else
        rmdir folder_path '("D:\changeAfter_Files")
        MkDir folder_path '("D:\changeAfter_Files")
    End If
End Sub

工作簿相关

工作表相关

工作表若存在则删除后新建,否则直接新建


Sub remove_and_make_sheet(SheetName As String)
    Dim Exists As Boolean
    With ThisWorkbook
        On Error Resume Next
        Exists = (.Worksheets(SheetName).Name <> "")
        On Error GoTo 0
        If Not Exists Then
            .Sheets.Add After:=.Sheets(.Sheets.Count)
            .Sheets(.Sheets.Count).Name = SheetName
        End If
    End With
End Sub
评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

小鲤鱼儿

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值