Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2925|回复: 11

[已解决]点击按钮将C盘,DATA文件夹中的表格,拷贝到D盘,

[复制链接]
发表于 2016-5-2 22:00 | 显示全部楼层 |阅读模式
214225.jpg

DATA.rar (11.33 KB, 下载次数: 12)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-5-2 22:28 | 显示全部楼层
Sub Test()
    Dim fso As Object, fld As Object, f As Object
    Dim p As String, SourceFile As String, DestinationFile As String, ext As String
    Dim i As Integer

    p = "C:\DATA"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.folderexists(p) Then
        Set fld = fso.GetFolder(p)    '得到文件夹对象 fld
        For Each f In fld.Files
            i = i + 1
            SourceFile = p & "\" & f.Name    ' 指定源文件名。
            ext = fso.GetExtensionName(SourceFile)
            DestinationFile = "D:\【工作记录】2016-05-03-第00" & i & "次保存." & ext       ' 指定目的文件名。
            FileCopy SourceFile, DestinationFile    ' 将源文件的内容复制到目的文件中。
        Next f
    Else
        MsgBox "无效路径"
    End If
End Sub


工作记录2.rar (13.46 KB, 下载次数: 14)

评分

参与人数 1 +1 收起 理由
cabcd1 + 1 大神一个啊

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-5-2 23:10 | 显示全部楼层
本帖最后由 excel010 于 2016-5-2 23:14 编辑
爱疯 发表于 2016-5-2 22:28
Sub Test()
    Dim fso As Object, fld As Object, f As Object
    Dim p As String, SourceFile As St ...
723.jpg
表格运行时【出现70错误:拒绝的权限】

我想把C盘DATA文件夹中的 【工作记录】
拷贝到D盘DATA文件夹中,保存名称格式:    工作记录2016-05-03-第001次备份
                                                                       表格名称 系统日期  当前保存次数
                                                                       当前日期再次保存 效果为  :工作记录2016-05-03-第002次备份
回复

使用道具 举报

发表于 2016-5-3 08:55 | 显示全部楼层
1)权限问题,应该是在你的操作系统源文件路径、目标文件路径有限制吧?我这里试了可复制。

2)c:\data\里,只有1个文件吗?该文件是什么扩展名?
回复

使用道具 举报

 楼主| 发表于 2016-5-3 22:26 | 显示全部楼层
爱疯 发表于 2016-5-3 08:55
1)权限问题,应该是在你的操作系统源文件路径、目标文件路径有限制吧?我这里试了可复制。

2)c:\data\ ...

意思是,C盘DATA文件夹中的文件就是当前打开的(工作记录)表,
想在保存时自动重新命名为:工作记录+系统日期+自动序号=效果(工作记录2016-05-03-第001次保存)
回复

使用道具 举报

发表于 2016-5-3 22:45 | 显示全部楼层
Sub test()
    Dim p$, f$

    p = "c:\data\"
    If Dir(p, vbDirectory) = "" Then ChDir VBA.Left(p, 3): MkDir p
    f = "工作记录" & Format(Now, "yyyymmdd-hhmmss")
    ActiveWorkbook.SaveAs p & f
End Sub



建议另存为时间就好了,方便简单。
回复

使用道具 举报

 楼主| 发表于 2016-5-3 23:12 | 显示全部楼层
爱疯 发表于 2016-5-3 22:45
Sub test()
    Dim p$, f$

老师!谢谢您一直帮我解决问题!

保存之后的效果达到了,

我想要的效果是,直接复制DATA中的(工作记录)表,到D盘DATA文件夹中,不是用Save,是要用Copy.{:26:}
回复

使用道具 举报

发表于 2016-5-4 11:48 | 显示全部楼层
Private Sub CommandButton1_Click()
    Dim p$, f$
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    p = "c:\data\"
    If Dir(p, vbDirectory) = "" Then ChDir VBA.Left(p, 3): MkDir p
    f = "工作记录" & Format(Now, "yyyymmdd-hhmmss")

    Sheets.Copy
    ActiveWorkbook.SaveAs p & f
    ActiveWorkbook.Close
End Sub


工作记录2.rar (13.77 KB, 下载次数: 5)
回复

使用道具 举报

 楼主| 发表于 2016-5-5 08:42 | 显示全部楼层
爱疯 发表于 2016-5-4 11:48
Private Sub CommandButton1_Click()
    Dim p$, f$
    Application.ScreenUpdating = False

老师,请稍微再改下。
将保存的文件放在D盘,data文件夹中,
并且连表格中的宏和窗体一并复制过去!
回复

使用道具 举报

发表于 2016-5-6 21:52 | 显示全部楼层    本楼为最佳答案   
Private Sub CommandButton1_Click()
    Dim DestinationPath As String

    DestinationPath = "D:\DATA\"
    ThisWorkbook.Save

    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(DestinationPath) = False Then
            .CreateFolder DestinationPath
        End If

        .CopyFile ThisWorkbook.FullName, DestinationPath
    End With

End Sub
工作记录3.rar (14.27 KB, 下载次数: 10)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 21:09 , Processed in 0.836145 second(s), 17 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表