VBA Сохранить как текущее имя файла +01

Я хочу написать макрос, чтобы сохранить мое текущее имя файла версии +1 экземпляр версии. Для каждого нового дня версия сбрасывалась на v01. Бывший. Текущий = DailySheet_20150221v01; Сохранить как = DailySheet_20150221v02; Следующий день = DailySheet_20150222v01

Увеличивая номер версии, я надеюсь, что версия не должна будет содержать v0 после достижения v10+.

Мне удалось потренироваться, как сохранить файл с сегодняшней датой:

Sub CopyDailySheet()

Dim datestr As String

datestr = Format(Now, "yyyymmdd")

ActiveWorkbook.SaveAs "D:\Projects\Daily Sheet\DailySheet_" & datestr & ".xlsx"

End Sub

но нужна дополнительная помощь в поиске дополнения к версии. Могу ли я установить SaveAs в строку, а затем запустить ее через For/If - Then set?


filenames excel iteration vba save-as
person PlainsWind    schedule 22.02.2015    source источник
comment
Дата не зависит от номера версии или вы каждый день сбрасываете номер версии на 1?   -  person Porcupine911    schedule 28.02.2015
comment
@Porcupine911 Да, я каждый день сбрасываю номер версии на 1.   -  person PlainsWind    schedule 28.02.2015
comment
Тогда нам придется пойти с чем-то вроде ответа Powershell от Bu_ali.   -  person Porcupine911    schedule 28.02.2015

Ответы (3)


arrow_upward
1
arrow_downward

Отправьте это паре моих друзей, и ниже приведено их решение:

Sub Copy_DailySheet()

Dim datestr As String, f As String, CurrentFileDate As String, _
    CurrentVersion As String, SaveAsDate As String, SaveAsVersion As String


    f = ThisWorkbook.FullName
    SaveAsDate = Format(Now, "yyyymmdd")
    ary = Split(f, "_")
    bry = Split(ary(UBound(ary)), "v")
    cry = Split(bry(UBound(bry)), ".")
    CurrentFileDate = bry(0)
    CurrentVersion = cry(0)
    SaveAsDate = Format(Now, "yyyymmdd")

    If SaveAsDate = CurrentFileDate Then
        SaveAsVersion = CurrentVersion + 1
    Else
        SaveAsVersion = 1
    End If

    If SaveAsVersion < 10 Then
        ThisWorkbook.SaveAs "D:\Projects\Daily Sheet\DailySheet_" & SaveAsDate & "v0" & SaveAsVersion & ".xlsm"
    Else
        ThisWorkbook.SaveAs "D:\Projects\Daily Sheet\Daily Sheet_" & SaveAsDate & "v" & SaveAsVersion & ".xlsm"
    End If

End Sub

Спасибо всем, кто внес свой вклад.

person PlainsWind    schedule 01.03.2015

arrow_upward
1
arrow_downward

Попробуй это:

Sub CopyDailySheet()

'Variables declaration
Dim path As String
Dim sht_nm As String
Dim datestr As String
Dim rev As Integer
Dim chk_fil As Boolean
Dim ws As Object

'Variables initialization
path = "D:\Projects\Daily_Sheet"
sht_nm = "DailySheet"
datestr = Format(Now, "yyyymmdd")
rev = 0

'Create new Windows Shell object
Set ws = CreateObject("Wscript.Shell")

'Check the latest existing revision number
Do
rev = rev + 1
chk_fil = ws.Exec("powershell test-path " & path & "\" & sht_nm & "_" & datestr & "v" & Format(rev, "00") & ".*").StdOut.ReadLine
Loop While chk_fil = True

'Save File with new revision number
ActiveWorkbook.SaveAs path & "\" & sht_nm & "_" & datestr & "v" & Format(rev, "00") & ".xlsm"

End Sub
person bu_ali    schedule 25.02.2015
comment
Есть ли что-то особенное, что мне нужно сделать для WshShell? Я получаю сообщение Ошибка компиляции: определяемый пользователем тип не определен в файле Dim ws As WshShell. - person PlainsWind; 26.02.2015
comment
О, извините, забыл упомянуть, что вы должны включить соответствующую ссылку. Вы можете сделать это следующим образом: 1- Откройте MS VBA в Excel 2- Нажмите Инструменты на панели инструментов 3- Выберите Ссылки 4- Найдите Windows Script Host Object Model и добавьте его, установив флажок рядом с ним. 5- Нажмите OK. 6- Снова скомпилируйте скрипт. - person bu_ali; 27.02.2015
comment
Или вы можете просто заменить следующее: Dim ws As WshShell на Dim ws As Object и Set ws = New WshShell на Set ws = CreateObject("Wscript.Shell") - person bu_ali; 27.02.2015
comment
Это откроет и запустит Windows PowerShell, но затем выдаст ошибку времени выполнения «13»: несоответствие типов . Особенности отладки chk_fil = ws.Exec("powershell test-path " & path & "\" & sht_nm & "_" & datestr & "v" & Format(rev, "00") & ".*").StdOut.ReadLine - person PlainsWind; 28.02.2015
comment
Вам просто нужно изменить имя пути. Во всяком случае, я изменил его для вас в коде на D:\Projects\Daily Sheet и изменил объявление переменной ws (для более поздней привязки) так что вы больше не сталкиваетесь с этой ошибкой компиляции. Пожалуйста, скопируйте код еще раз. - person bu_ali; 01.03.2015
comment
Я попытался сделать это с обновленной информацией, но он возвращает те же результаты. В целях безопасности файл фактически сохраняется не на D:\, а на мой рабочий стол; это будет причиной ошибки? - person PlainsWind; 01.03.2015
comment
Да, ты прав. Это происходит из-за пробела в названии папки Daily Sheet. Итак, я просто изменил его на Daily_Sheet. Но помните, вам также нужно переименовать папку. - person bu_ali; 03.03.2015

arrow_upward
0
arrow_downward

Если у вас есть текущее имя файла, я бы использовал что-то вроде:

Public Function GetNewFileName(s As String) As String
    ary = Split(s, "v")
    n = "0" & CStr(CLng(ary(1)) + 1)
    GetNewFileName = ary(0) & "v" & ary(1)
End Function

Протестировано с:

Sub MAIN()
    strng = GetNewFileName("DailySheet_20150221v02")
    MsgBox strng
End Sub
person Gary's Student    schedule 22.02.2015
comment
Так что всегда дополняется нулем. v010? - person shawnt00; 22.02.2015
comment
@ Гэри Студент Я хотел бы понять вашу функцию и подпрограмму, но я не понимаю, как проходит информация. Когда я запускаю это, я получаю MsgBox с DailySheet_20150221v02. Правильно ли я размещаю их в одном модуле? - person PlainsWind; 28.02.2015