VBScript for locating the current day's email for a specific file...

netwerkz

New Member
Joined
Nov 25, 2014
Messages
21
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:
Code:
Sub runGrain()
    Call grain1
    ActiveWorkbook.Close
    Set Workbook = Nothing
    Application.Quit
End Sub

This 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 Sub


This is the tiny *.docx code:
Code:
Sub rungrainComments1()    Call grainComments1
    ActiveDocument.Close
    Set Document = Nothing
    Application.Quit
End Sub

This 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 Sub

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.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top