VBscript. Имя Excel файла с текущей датой и временем

Question

есть код который формирует "Отчет" в Excel. Необходимо сделать чтобы имя файла сохранялось с текущей датой и временем. Так же пробовал, создавать просто таблицу, а потом сохранять в директорию. Не совсем понятно, что я делаю не так.
В основном пользовался:

Собственно фрагмент кода:

```  Dim objExcel, activeWB, activeSheet,objWorkbook,Storage_Path
    Dim tp, strPath, Fn
    Set objExcel = CreateObject("Excel.Application")
    Storage_Path = "D:\Stat\" 
    Fn = Format(CStr(Now), "yyyy_mm_dd_hh_mm_ss_")
    tp = ".xlsx"
    strPath = Storage_Path&Fn&tp
    objExcel.Visible = False
    
    Set objWorkbook = objExcel.Workbooks.Add ()
    'objExcel.workbooks.SaveAs SaveDateTime(String)
    objExcel.ActiveSheet.Columns("A").ColumnWidth = 20
    objExcel.ActiveSheet.Columns("B").ColumnWidth = 45
    objExcel.ActiveSheet.Columns("C").ColumnWidth = 15
    '
    objExcel.ActiveSheet.Cells(1,1).Value="Отчет"
    objExcel.ActiveSheet.Cells(1,1).Font.Bold = True
    objExcel.ActiveSheet.Range("A1:C1").Font.Size = 20
    objExcel.ActiveSheet.Range("A1:C1").Borders.LineStyle = 1
    objExcel.ActiveSheet.Range("A1:C1").MergeCells = True
    objExcel.ActiveSheet.Cells(1,1).HorizontalAlignment = -4108
    '
    objExcel.ActiveSheet.Range("A2:C2").Font.Bold = True
    objExcel.ActiveSheet.Range("A2:C2").Font.Size = 14
    objExcel.ActiveSheet.Range("A2:C2").Borders.LineStyle = 1
    objExcel.ActiveSheet.Range("A2:C2").HorizontalAlignment = -4108
    objExcel.ActiveSheet.Cells(2,1).Value="Продукт"
    objExcel.ActiveSheet.Cells(2,2).Value="Время"
    objExcel.ActiveSheet.Cells(2,3).Value="Сумма"
    objExcel.ActiveSheet.Range("A2:C2").WrapText = True
    
    
    Dim index,element
    index=3
    
    For Each element In items
        Dim subelement
        subelement = Split(element, ";")
        If UBound(subelement)>=2 Then 
            objExcel.ActiveSheet.Range("A"+CStr(index)+":C"+CStr(index)).Font.Size = 13
            objExcel.ActiveSheet.Range("A"+CStr(index)+":C"+CStr(index)).WrapText = True
            objExcel.ActiveSheet.Range("A"+CStr(index)+":C"+CStr(index)).Borders.LineStyle = 1
            objExcel.ActiveSheet.Range("A"+CStr(index)+":C"+CStr(index)).HorizontalAlignment = -4108
            objExcel.ActiveSheet.Cells(index,1).Value=subelement(0)
            objExcel.ActiveSheet.Cells(index,2).Value=subelement(1)
            objExcel.ActiveSheet.Cells(index,3).Value=subelement(2)
        End If
        index=index+1
    Next
    ' Save and quit.
    
    objExcel.ActiveWorkbook.SaveAs (strPath)
    objExcel.ActiveWorkbook.Close
    objExcel.Application.Quit
    'objExcel.workbooks.SaveAs "D:\Stat\1.xlsx"
    'objExcel.workbooks.close
    'objExcel.quit
    'Set objExcel = Nothing
    Set objExcel = Nothing 
End Sub   ```

Answer 1

Ошибка связана с неправильным использованием Format

Рабочий код:

Function FormatDateYYYYMMDD(D)
    FormatDateYYYYMMDD = Year(D) & "_" & Format2DigitString(Month(D)) & "_" & Format2DigitString(Day(D))
End Function

Function FormatDateYYYYMMDDHHMMSS(D)
    FormatDateYYYYMMDDHHMMSS = FormatDateYYYYMMDD(D) &  "_" & Format2DigitString(Hour(D)) &  "_" & Format2DigitString(Minute(D)) &  "_" & Format2DigitString(Second(D))
End Function

Function Format2DigitString(N)
    If N >= 10 Then
        Format2DigitString= Format2DigitString & N
    Else
        Format2DigitString= Format2DigitString & "0" & N
    End If
End Function

    Dim objExcel, activeWB, activeSheet,objWorkbook,Storage_Path
    Dim tp, strPath, Fn
    Storage_Path = "F:\Test\" 
    Fn = FormatDateYYYYMMDDHHMMSS(Now)
    tp = ".xlsx"
    strPath = Storage_Path & Fn & tp
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    
    Set objWorkbook = objExcel.Workbooks.Add ()
' Здесь что-то написать в новую книгу:
    objWorkbook.Worksheets(1).Range("A1").Value = "Эта новая книга будет сохранена в " & strPath
    objWorkbook.SaveAs (strPath)
    objWorkbook.Close
    objExcel.Application.Quit
 
    Set objExcel = Nothing

БЛОГ НА HUSL

VBscript. Имя Excel файла с текущей датой и временем

Ответы (1 шт):