Страницы: 1
RSS
Сохранение файла в папке с уникальным именем
 
Господа знатоки, доброго времени!

Не поможете задать в нижеприведенном коде, чтобы файл сохранялся с уникальным именем - либо через слеш текущее время, либо число в скобках, либо что то подобное... Ссылка на ячейку с TDATA() дает 15 значную кракозябру...

Это сохранение используется в макросе отправки листа excel по e-mail. Поэтому, если в этот день нужна будет еще одна отправка такого файла по e-mail, предыдущий файл просто заменится, а мне нужно, чтобы в указанной папке сохранились все файлы...

Код
ActiveWorkbook.SaveAs FileName:="G:\DEPTS\" & Название_листа & "_" & Текущая_дата & ".xls", FileFormat:=xlNormals
Wra = ActiveWorkbook.Name
Workbooks(sWra).Close SaveChanges:=False
 
Добавьте к имени файла
Код
Format(Now(), "yyyyMMddmmss")
 
Так как раз и получается пятнадцатизначная кракозябра типа 48003,0499589500
 
эта "пятнадцатизначная кракозябра" ничто иное, как Дата-время в числовом формате
замените
Код
ActiveWorkbook.SaveAs FileName:="G:\DEPTS" & Название_листа & "_" & Текущая_дата & ".xls", FileFormat:=xlNormals

на
Код
ActiveWorkbook.SaveAs FileName:="G:\DEPTS" & Название_листа & "_" & Format(Now(), "yyyyMMddhhmmss") & ".xls", FileFormat:=xlNormals

в результате к файлу добавится строка типа 20150406173745 (год, месяц, день, часы, минуты, секунды записанные слитно)
если надо более понятную запись - добавьте в шаблон формата любые разделители. например, так:
Код
Format(Now(), "yyyy-MM-dd hh-mm-ss")
 
Вот кусок кода из рабочего файла. Как-то тоже были претензии к длиннонепонятному коду в имени файла.
К имени книги добавляем индекс:
Код
 ' ---------- сохраняем книгу с проверкой имени ----------------------------------------
    i = 1
    ReDim ArrName(1 To 1, 1 To 1)
    sPath = ThisWorkbook.Path & "\" ' путь к папке
    sName = Dir(sPath & "*.xls", vbReadOnly)

    Do While sName <> ""
        ArrName(1, i) = sName ' имя файла в список
        i = i + 1
        ReDim Preserve ArrName(1 To 1, 1 To i)
        sName = Dir ' следующий файл
    Loop
    
    sName = "Имя_книги_" ' предполагаемое имя книги (без номера)
    
    n = 1
    For i = 1 To UBound(ArrName, 2) '  если книга есть, увеличиваем номер
        If ArrName(1, i) = sName & n & ".xls" Then n = n + 1
    Next i

    sName = sName & n ' имя книги с номером
    
    With ThisWorkbook ' сохранить новую книгу
        .SaveAs sPath & sName, xlWorkbookNormal, CreateBackup:=False
    End With
 
Всем огромное спасибо!

В итоге победил так:
Код
Sheets("Заявка").Copy
strdate = Format(Now, "dd-mm-yy hh-mm")
ActiveWorkbook.SaveAs FileName:="G:\DEPTS" & Название_листа & "_" & strdate & ".xls", FileFormat:=xlNormals
sWra = ActiveWorkbook.Name
Workbooks(sWra).Close SaveChanges:=False
Изменено: Church - 06.04.2015 17:58:41
 
Цитата
webley написал: добавьте в шаблон формата любые разделители
Любые нельзя. Точки неприемлемы.
 
Church, небольшой комментарий
На мой взгляд, при использовании даты в имени файла предпочтительней все-таки обратный порядок записи:
Код
strdate = Format(Now, "yy-MM-dd hh-mm")

Это обеспечит правильную сортировку файлов по возрастанию дат
 
Ну ведь есть в "Приемах".
   
 
Цитата
webley написал: strdate = Format(Now, "yy-MM-dd hh-mm" )
Спасибо! )
 
Добрый день.
Воспользовался  указанным   способом

   Sheets("продажи +ООО").Select
   strdate = Format(Now, "YY-MM-DD hh-MM")
    ActiveWorkbook.SaveAs Filename:="\\MAIL\change\ОТЧЕТЫ общие\" & "Ежедневный по продажам " & strdate & ".xlsx", FileFormat:=xlNormal
   sWra = ActiveWorkbook.Name
   Workbooks(sWra).Close SaveChanges:=False

Но в  процессе  сохранения  он  ссылается  на  то  что  сохранение будет  в  старом  формате ,  не смотря  на ".xlsx" в  строке.
И  самое  обидное  что исходный  файл из 1 мб вырастает до  9 мб! после  сохранения

Может  есть способ  как заменить на более современную версию ?
9 мб  по  почте   не  всегда  удобно  отправлять.
Спасибо
 
Цитата
diP написал:
FileFormat:=xlNormal
 
Цитата
Hugo написал:
Цитата
Hugo написал:
Цитата diP  написал:
FileFormat:=xlNormal
А  как  должно  быть?
 
Запишите желаемое рекордером - увидите.
 
Тоже  спасибо.)
Страницы: 1
Наверх