Hello all,
I have been searching all over the web and cannot find how to script for "watching" the current day's outlook email for a *.xlsx file and *.docx file. I have scripts to run on those files, which will do all of the formatting, saving, and closing of each application once complete. I need to locate the email, open the document, run the macro for that file, search for the next file and do the same. I do not need to move the attachments, because it's already done in my scripts.
For example, I want the script to run in outlook to watch for an email that comes in with the subject line "Company Bidsheet" and has an attachment named "Diversified Bidsheet.xlsx". I want Outlook 2016 to then run a tiny script opening Excel 2016 and run another script (both of which work perfectly in manual mode). then, it will watch for another email with "comments" in the subject line and has an attachment named "Afternoon Comments {currentMonth[June] currentDate[2]}.docx", which comes later, after the commodities markets close. I want Outlook to then run another tiny script I wrote to open Word 2016, run another script (again, both are working perfectly in manual mode).
This is the tiny *.xlsx code:
This is the script it runs...
This is the tiny *.docx code:
This is the script it runs...
The *.docx file has a table within that needs reformatting before saving and posting the report on the Business Name Inc website. That's why it has a lot more code to it. It's the only way I could figure out how to do it. Unfortunately, it's never formatted the same day-by-day.
Any suggestions on how to construct my Outlook code is greatly appreciated.
I have been searching all over the web and cannot find how to script for "watching" the current day's outlook email for a *.xlsx file and *.docx file. I have scripts to run on those files, which will do all of the formatting, saving, and closing of each application once complete. I need to locate the email, open the document, run the macro for that file, search for the next file and do the same. I do not need to move the attachments, because it's already done in my scripts.
For example, I want the script to run in outlook to watch for an email that comes in with the subject line "Company Bidsheet" and has an attachment named "Diversified Bidsheet.xlsx". I want Outlook 2016 to then run a tiny script opening Excel 2016 and run another script (both of which work perfectly in manual mode). then, it will watch for another email with "comments" in the subject line and has an attachment named "Afternoon Comments {currentMonth[June] currentDate[2]}.docx", which comes later, after the commodities markets close. I want Outlook to then run another tiny script I wrote to open Word 2016, run another script (again, both are working perfectly in manual mode).
This is the tiny *.xlsx code:
Code:
Sub runGrain()
Call grain1
ActiveWorkbook.Close
Set Workbook = Nothing
Application.Quit
End SubThis is the script it runs...
Code:
Sub runGrain()
Call grain1
ActiveWorkbook.Close
Set Workbook = Nothing
Application.Quit
End Sub
Sub grain1()
'
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")
'
Application.ActiveProtectedViewWindow.Edit
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
'
Columns("B:F").Select
Selection.ColumnWidth = 17
'
With ActiveSheet.PageSetup
.CenterFooter = "Business Name Inc"
.RightFooter = year_Month_Date
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
'
Range("A1:F1,A2:F2,A3:F3,A4:F4,A5:F5,A6:F6,A7:F7,A8:F8,A10:C10,A17:C17,A27:C27,A34:C34,A40:C40,A46:F46,A53:F53").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = True
End With
Columns("G:I").Select
Selection.Delete Shift:=xlToLeft
Rows("44:46").Select
Selection.Delete Shift:=xlUp
Range("A10:F11,A17:F18,A27:F28,A34:F35,A40:F41,A45:F45").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = -0.499984740745262
.PatternTintAndShade = 0
End With
Range("A45:F47,A40:F43,A34:F38,A27:F32,A17:F25,A10:F15").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
'
Columns("B:F").Select
Selection.ColumnWidth = 23
'
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Range("A51").Select
'
' This is the save portion
'
ActiveWorkbook.SaveAs Filename:="D:\Projects\Website\Grain\" & year_ & "\" & year_Month & "\" & year_Month_Date & " - " & "Diversified Bidsheet.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\Projects\Website\Grain\" & year_ & "\" & year_Month & "\" & year_Month_Date & " - " & "Diversified Bidsheet.pdf"
'
End SubThis is the tiny *.docx code:
Code:
Sub rungrainComments1() Call grainComments1
ActiveDocument.Close
Set Document = Nothing
Application.Quit
End SubThis is the script it runs...
Code:
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.3)
.FooterDistance = InchesToPoints(0.3)
.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 removes extra lines at the bottom of the document
'
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory
Selection.TypeBackspace
'
' This section manipulates the table
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=11
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Rows.Delete
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.Columns.Delete
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.MoveLeft Unit:=wdCell
Selection.InsertRowsAbove 1
Selection.Cells.Merge
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = -570392321
Selection.TypeText Text:="Weekly Closing Future Prices"
Selection.Tables(1).Select
'
Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
Selection.MoveDown Unit:=wdLine, Count:=1
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Cells.Merge
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'
' 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 SubThe *.docx file has a table within that needs reformatting before saving and posting the report on the Business Name Inc website. That's why it has a lot more code to it. It's the only way I could figure out how to do it. Unfortunately, it's never formatted the same day-by-day.
Any suggestions on how to construct my Outlook code is greatly appreciated.
