SaveAs автоматически включает автосохранение в Excel VBA - PullRequest
0 голосов
/ 27 марта 2020

У меня есть большой файл, который загружает цены ежедневно, а затем сохраняет резервную копию файла под новым именем с прикрепленным суффиксом даты. Хотите сохранить это только на локальном диске и не иметь автоматической загрузки на Sharepoint. Это происходит по двум причинам: (1) скорость - иногда сетевое соединение медленное, а сохранение в Sharepoint снижает производительность, и (2) диалоговое окно «Загрузка в Sharepoint», кажется, зависает, даже после того, как файл явно загружен.

Несмотря на то, что я выключил автосохранение, оно, похоже, автоматически возвращается при запуске кода .SaveAs. Это из-за формата файла, который был выбран? Я обычно использую .xlsb, чтобы уменьшить размер файла.

Вот код, который я использую:

Dim OrigName As String
Dim FilePath As String
Dim NewName As String
Dim DateSuffix As String

If ActiveWorkbook.AutoSaveOn = True Then
    ActiveWorkbook.AutoSaveOn = False
    Application.AutoRecover.Enabled = False
End If

SaveStart = Timer
Sheets("Parameters").Activate
RptDt = Range("End_Date").Offset(0, 1)
DateSuffix = Format(RptDt, "yyyymmdd") 'Year(RptDt) & Month(RptDt) & Day(RptDt)
Path = ActiveWorkbook.Path
OrigName = ActiveWorkbook.Name
OrigName = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
NewName = OrigName & " " & DateSuffix
If Right(ActiveWorkbook.Name, 4) = "xlsb" Then
    NewName = Path & "\" & NewName & ".xlsb"
    OrigName = Path & "\" & OrigName & ".xlsb"
Else
    NewName = Path & "\" & NewName & ".xlsm"
    OrigName = Path & "\" & OrigName & ".xlsm"
End If
Application.Calculation = xlCalculationManual

With ActiveWorkbook
    If Right(.Name, 4) = "xlsb" Then
        Application.DisplayAlerts = False
        .SaveAs NewName, FileFormat:=xlExcel12
        Application.DisplayAlerts = True
        BeforeSave2 = Timer
        Application.DisplayAlerts = False
        .SaveAs OrigName, FileFormat:=xlExcel12
        Application.DisplayAlerts = True
    Else
        Application.DisplayAlerts = False
        .SaveAs NewName, FileFormat:=52
        Application.DisplayAlerts = True

        Application.DisplayAlerts = False
        .SaveAs OrigName, FileFormat:=52
        Application.DisplayAlerts = True
    End If
End With

Application.DisplayAlerts = True


ActiveWorkbook.AutoSaveOn = True
Application.AutoRecover.Enabled = True

1 Ответ

0 голосов
/ 27 марта 2020

Вот пересмотренный код с использованием SaveCopyAs:

NewName = NewName & ".xlsb"
OrigName = OrigName & ".xlsb"

With ActiveWorkbook
    If Right(.Name, 4) = "xlsb" Then
        Application.DisplayAlerts = False
        .SaveCopyAs NewName
        .SaveCopyAs OrigName
        Application.DisplayAlerts = True
    Else
        Application.DisplayAlerts = False
        .SaveCopyAs NewName
        .SaveCopyAs OrigName
        Application.DisplayAlerts = True
    End If
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...