我正在尝试打开目录中的最后一个修改的文件。
每次我运行下面的代码时，都会收到“找不到文件...”消息，但我知道文件夹中有文件。我相信这与“如果正确...”有关。 / p>
指定路径中的文件名为“ CAB_m_d.xlsx”。我在做什么错了？
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\Users\...."
Option Explicit
Sub UpdateBusinessJustification()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object, LastRow As Long,
objDoc As Object, objWord As Object, objSelection As Object, nonProdCount As
Integer, nonProdDT As Integer
Dim oOlItm As Object, oOlAtch As Object, fname As String, sFound As String,
totalRowCount As Integer, wFound As String, wdRange As Word.Range, str As
String, nonProdCopyToWord As Long
Dim wb As Workbook, uRng As Range, tbl As Table, ProdCount As Integer,
ProdDT As Integer, myDate As Date, tableCount As Integer, MyPath As String,
MyFile As String, LatestFile As String
Dim LatestDate As Date, LMD As Date
MyPath = "C:\Users\Documents"
If Right(MyPath, 1) <> " \ " Then MyPath = MyPath & " \ "
MyFile = Dir(MyPath & " * .xlsx", vbNormal)
If Len(MyFile) = 0 Then
MsgBox "No files were found…", vbExclamation
Exit Sub
End If
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = "MorningOpsFile " & Format(Date, "MM-DD-YYYY")
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox).Folders("Daily CAB
Reports")
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
Set objSelection = objWord.Selection
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
'~~> Check if the email actually has an attachment
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
'~~> Download the attachment
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Exit For
Next
Else
MsgBox "The First item doesn't have an attachment"
End If
Exit For
Next
'~~> Mark 1st unread email as read
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
oOlItm.UnRead = False
DoEvents
oOlItm.Save
Exit For
Next
'--> Search for downloaded file without knowing exact filename
sFound = Dir(ActiveWorkbook.Path & "\*Data Center CAB*.xlsx")
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & sFound
End If
Set uRng = ActiveSheet.Range("A1:A2")
'--> Set variable for last row in sheet containing data
LastRow = Sheets("Combined CAB Agenda").Cells(Rows.Count, 1).End(xlUp).Row
'--> Apply filter to look for today's changes
With Sheets("Combined CAB Agenda").Select
Range("$A$1:AB" & LastRow).AutoFilter Field:=3, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic
'--> Get a total row count of today's changes
totalRowCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
End With
End Sub