Если файл существует, сохраните как с отметкой времени - PullRequest
Новая
       6

Если файл существует, сохраните как с отметкой времени

0 голосов
/ 29 августа 2018

Я пытаюсь заставить следующее работать в моем коде. Я был макросом, чтобы связать файл и, если он уже существует, сохранить как с дополнительной отметкой времени в конце. У меня есть следующее, но это останавливается на "ActiveWorkbook.SaveAs (FPath &" \ "& FName & Format (DateTime.Now," гггг-ММ-дд чч: мм: сс ") &" xlsx ")" Любые предложения, которые я я делаю не так? 

'~~> Save the file

Dim TestStr As String

TestStr = ""

On Error Resume Next
TestStr = Dir(FPath & "\" & FName & ".xlsx")

On Error GoTo 0
If TestStr = "" Then
MsgBox "New file name: " & FName & ".xlsx"
ActiveWorkbook.SaveAs filename:=FPath & "\" & FName & ".xlsx", FileFormat:=51
Workbooks(FName & ".xlsx").Close

'~~> Mark as saved
Workbooks("Sample.xlsm").Worksheets("Front Page").Cells(Application.Match("Vendor", Worksheets("Front Page").Range("A1:A42"), 0), 3).Value = "OK"

Else
MsgBox "File " & FName & ".xslx" & " already exist." & vbCrLf & "New vesion saved with timestamp."
ActiveWorkbook.SaveAs (FPath & "\" & FName & Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") & "xlsx")
Workbooks(FName & Format(Now(), "yyyy-MM-dd hh:mm:ss") & ".xlsx").Close

End If

Exit Sub

1 Ответ

0 голосов
/ 29 августа 2018

У вас не может быть : в именах файлов, также вы пропустили полную остановку Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss") & "xlsx") перед " xlsx ", так что следующее достигнет того, что вы ожидаете: 

Dim TestStr As String

TestStr = ""

On Error Resume Next
TestStr = Dir(FPath & "\" & FName & ".xlsx")

On Error GoTo 0
If TestStr = "" Then
    MsgBox "New file name: " & FName & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=FPath & "\" & FName & ".xlsx", FileFormat:=51
    Workbooks(FName & ".xlsx").Close

    '~~> Mark as saved
    Workbooks("Sample.xlsm").Worksheets("Front Page").Cells(Application.Match("Vendor", Worksheets("Front Page").Range("A1:A42"), 0), 3).Value = "OK"
Else
    MsgBox "File " & FName & ".xslx" & " already exist." & vbCrLf & "New vesion saved with timestamp."
    ActiveWorkbook.SaveAs (FPath & "\" & FName & Format(DateTime.Now, "yyyy-MM-dd hh-mm-ss") & ".xlsx")
    Workbooks(FName & Format(Now(), "yyyy-MM-dd hh-mm-ss") & ".xlsx").Close
End If

Exit Sub
...