I want to use an auto-date function in my script

[netwerkz]

Hello all,

I have a question regarding the use of an auto-date function in my script. This is what I use in my excel VBScript...



year_ = Format(DateAdd("m", 0, Date), "yyyy")
year_Month = Format(DateAdd("d", 0, Date), "yyyy Mmm")
year_Month_Date = Format(DateAdd("d", 0, Date), "yyyy Mmm dd")
Mnth = Format(Application.WorksheetFunction.EoMonth(Date, 1), "Mmm")


I want to use something of the same in my Word9 VBScript. But, "Application.WorksheetFunction" will not work in Word. I've even tried using "Application.wdWordFunction" and numerous variations, but none will work.

So far, I have this much code, which works, but when it comes to the save portion, it only goes as far as "D:\Projects\Website\Grain\" and saves the document in that folder. I have nested folders for each month within a year, such as 2017 > 2017 Jun and save all documents in the "yyyy Mmm dd" format for easy archiving and locating.



'
' This section adds the footer to the page
'
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.WholeStory
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
'
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.TypeText Text:="Business Name, Inc."
Selection.MoveRight Unit:=wdCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.InsertDateTime DateTimeFormat:="yyyy MMM dd", InsertAsField:= _
False, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
'
' This is the save portion
'
ActiveDocument.SaveAs2 FileName:="D:\Projects\Website\Grain\" & year_ & "\" & year_Month & "\" & year_Month_Date & " - " & "Afternoon Comments.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

ActiveDocument.ExportAsFixedFormat OutputFileName:="D:\Projects\Website\Grain\" & year_ & "\" & year_Month & "\" & year_Month_Date & " - " & "Afternoon Comments.pdf", ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
'
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'


The footer dating works great now...but I had to beat it into submission to make it work!!!

Does anyone have any suggestions?

Thanks,
JD

[netwerkz]

Never mind!!!
I went back through my other posts and decided to try something SamT suggested when I was working on my VBScript for Excel. I tweaked his suggestion a little and it worked like a CHARM!!! I even figured out how to get it to automatically close upon completion.



Sub rungrainComments1()
Call grainComments1
ActiveDocument.Close
Set Document = Nothing
Application.Quit
End Sub
Sub grainComments1()
'
NewDate = Format(DateAdd("m", 0, Date))
YMD = Format(NewDate, "yyyy Mmm dd") & " - "
YM = Format(NewDate, "yyyy Mmm") & "\"
Y = Format(NewDate, "yyyy") & "\"
'
' This section formats the page
'
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
'
' This section adds the footer to the page
'
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
With Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.WholeStory
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
'
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.TypeText Text:="Business Name Inc."
Selection.MoveRight Unit:=wdCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.InsertDateTime DateTimeFormat:="yyyy MMM dd", InsertAsField:= _
False, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
'
' This is the save portion
'
ActiveDocument.SaveAs2 FileName:="D:\Projects\Website\Grain\" & Y & YM & YMD & "Afternoon Comments.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

ActiveDocument.ExportAsFixedFormat OutputFileName:="D:\Projects\Website\Grain\" & Y & YM & YMD & "Afternoon Comments.pdf", ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, BitmapMissingFonts:=True, UseISO19005_1:=False
'
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'
End Sub




Now, to figure out the script to locate a table within the word document, delete all of the blank rows are in the top, as well as delete the last blank column, which this document ALWAYS comes with.

FUN TIMES!!!

[SamT]

In VBA, I use

Year_ = Format(Date, "yyyy")
Year_Mon = Format(Date, "yyyy mmm")
Year_Mon_Date = Format(Date, "yyyy mmm dd")
Mon = Format(Date, "mmm")
CurrentSaveFolder = Format(Date, "yyyy\mmm\")
THen, something like


GrainFolder = "D:\Projects\Website\Grain\"
Doc.SaveAs GrainFolder & CurrentSaveFolder & DocName