VBA:复制更新文件而不打开



我想打开文件,刷新数据(自动(并将更新后的文件复制到另一个文件夹。

我的代码是:

Option Explicit
Public Duree As Date
Function FichierExiste(FPath As String) As Boolean
Dim NomF As String
NomF = Dir(FPath)
If NomF <> "" Then FichierExiste = True _
Else: FichierExiste = False
End Function

Sub Fermer()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Application.DisplayAlerts = False
With ThisWorkbook
.RefreshAll
.Save
.Close
Application.DisplayAlerts = False
Call 
oFSO.CopyFile("\XXXXDossier_avantFichier.xlsm", "\XXXXDossier_apres", True)
End With
End Sub
Sub StartHeure()
Duree = Now + TimeValue("01:00:30")
Application.OnTime Duree, "Fermer"
End Sub

关于本手册:

Option Explicit
Private Sub Workbook_Open()
If FichierExiste("XXXXDossier_apresFichier.xlsm") = False Then
Call StartHeure
Else
ActiveWorkbook.Close True
End If
End Sub

当我复制更新的文件时,函数=today((仍然没有更新。我想知道我的鳕鱼哪里出了问题。

谢谢你的帮助!

请测试这种保存方式:

Sub Fermer()
Dim oFSO As Object, dateRng As Range

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set dateRng = ThisWorkbook.Sheets("my sheet").Range("J8") 'update here the range keeping the formula "=Now()" formula!
Application.DisplayAlerts = False
With ThisWorkbook
.RefreshAll
dateRng.value = dateRng.value
.Save
oFSO.CopyFile "\XXXXDossier_avantFichier.xlsm", "\XXXXDossier_apres", True
dateRng.Formula = "Now()"
.Close , True 'it is saved before closing (to keep the formula
End With
Application.DisplayAlerts = True
End Sub

编辑:复制它的版本没有任何公式:

Sub FermerNoFormula()
Dim wb As Workbook, sh As Worksheet
Set wb = ThisWorkbook
Application.DisplayAlerts = False
With wb
.RefreshAll
.saveas "\XXXXDossier_apres" & ThisWorkbook.Name
For Each sh In wb.Sheets
sh.UsedRange.value = sh.UsedRange.value
Next sh
.Close , True 'it is saved before closing
End With
Application.DisplayAlerts = True
End Sub

最新更新