每十分自动另存到指定路径

jivy1212

VBA太陌生，找了类似的贴没有完全达到，麻烦大佬出手了。
情景：有台电脑一个工作薄会24小时打开着有人录入相关数据。
需求:  自动另存或者说拷贝最新数据至其他路径方便其他人看
1.每10分钟自动另存到 D:\DHRP\查看专用.XLSM；
2.此电脑上不提示任何警示、不弹额外的框、在不影响这个工作薄续录数据的情况下另存；

准提部林

1) 每10分鐘...還是每次的10分0秒整?
2) 另存..那當前檔案就不是本尊了
3) 那用copy呢, 該檔正好開著, 怎辦???

建議以"捷徑"方式, 供人以"只讀"方式檢視

搭配ontime即可,
1) 要以10分0秒執行, 那就要每秒為一間隔(單元格放當前時間), 較浪費資源, 但可隨時檢視是否執行中
2) 不以0秒整為準, 那就以每10分為間隔, 但檔案擺著, 看不出來有沒有在動

准提部林

忘了, 另存可以用備份檔方式!!!
不知道可不可用, 沒用过!

aman1516

OnTime  +  SaveCopyAs

jivy1212

准提部林 发表于 2022-5-10 11:57
1) 每10分鐘...還是每次的10分0秒整?
2) 另存..那當前檔案就不是本尊了
3) 那用copy呢, 該檔正好開著, 怎 ...

1.10分就是间隔时间；
2.另存后当前不是本尊的问题，是不是可以先保存再备份到指定路径？

jivy1212

aman1516 发表于 2022-5-10 12:11
OnTime  +  SaveCopyAs

谢谢提示，我研究一下，已经找到类似代码，看看能不能成-------VBA没入门。

jivy1212

aman1516 发表于 2022-5-10 12:11
OnTime  +  SaveCopyAs

1. Sub 查看专用()
   
2. 
   
3. ThisWorkbook.SaveCopyAs Filename:="D:\DHRP\Excel\查看专用.xlsm"
   
4. 
   
5. End Sub
   
6. 
   
7. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
8. Application.OnTime Now + TimeValue("00:10:00"), "查看专用"
   
9. End Sub
   

复制代码

我手动执行有文件生成，但是不会10分钟自动刷新，哪段有问题，麻烦再指点一下，谢谢？

ykcbf1100

Worksheet_SelectionChange事件只有当选区发生改变时才会起作用。问题是你的选区有些时候并不会有变化，所以，用这个事件并不能真正做到每10分另存一次。

jivy1212

ykcbf1100 发表于 2022-5-10 14:25
Worksheet_SelectionChange事件只有当选区发生改变时才会起作用。问题是你的选区有些时候并不会有变化，所 ...

为了测试验证，我的数据区域都有变化的，应该还是我的代码有问题

dcb0513

1. 在Thisworkbook里插入以下代码：

Private Sub Workbook_Open()
Call AutoSave
End Sub

2. 在模块里插入以下代码：
Sub AutoSave()
Application.ScreenUpdating = False
Application.OnTime Now() + TimeValue("00:10:00"), "WbSave"       '10分钟保存一次
Application.ScreenUpdating = True
End Sub

Sub WbSave()
Application.ScreenUpdating = False
'ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Test\查看专用.XLSM"   '测试可以运行
ThisWorkbook.SaveCopyAs "D:\DHRP\查看专用.XLSM"
Call AutoSave
Application.ScreenUpdating = True
End Sub

测试可以运行。