Outlook似乎没有检测到Excel附件

时间:2016-06-14 15:18:10

标签: excel vba outlook outlook-vba

我目前的目标是当有人向我发送主题为 "SES Gas Matrix" 的电子邮件时,我的展望会将excel文档从电子邮件中删除,将其保存在指定位置,打开excel,在两个位置打印到pdf,然后从excel文档中复制各种单元格。

然后杀死excel文件。

我遇到的问题是我的代码在我上午发送给我的文档时下载,将其下载到计算机然后将其附加到自己的电子邮件中。这工作得非常好。

问题是当电子邮件来自源时,Outlook似乎没有意识到电子邮件上有一个excel附件。我正在接收电子邮件签名中的jpeg,而不是excel文档。这就是为什么我在if语句中添加了仅过滤excel文档的原因。

这解决了拉jpeg的问题,但它似乎仍然无法找到明显存在的excel文档。我也可以手动下载它。

以下是我目前使用的代码:

    Private WithEvents myOlItems  As Outlook.Items

    Private Sub Application_Startup()
      Dim olApp As Outlook.Application
      Dim objNS As Outlook.NameSpace
        Set olApp = Outlook.Application
        Set objNS = olApp.GetNamespace("MAPI")
        Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
    End Sub

     Private Sub myOlItems_ItemAdd(ByVal item As Object)

       'On Error Resume Next

        Dim Msg As Outlook.MailItem
        Dim msgattach As Object
        Dim wb As Workbook
        Dim myXLApp As Excel.Application
           If TypeName(item) = "MailItem" Then
              Set Msg = item

        Dim wbtemp As Workbook
        Dim testcode As Workbook

 If Left(Msg.Subject, 14) = "SES Gas Matrix" Then
    Set myXLApp = CreateObject("Excel.Application")
    myXLApp.Visible = True
    If Msg.Attachments.Count <> 0 Then
       For Each msgattach In Msg.Attachments
            If Right(msgattach.FileName, 5) = ".xlsx" Then
                FilePath = "G:\Betts\Floor Matricies\FIFOs\" & Format(Now(), "YYYYMMDD") & " - " & "Gas Rates" & Right(msgattach.FileName, 5)
                msgattach.SaveAsFile FilePath
            End If
            Exit For
       Next
    End If
    Set wbtemp = Workbooks.Open(FilePath)
    wbtemp.Activate
    FilePathtwo = Left(FilePath, Len(FilePath) - 5)

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    FilePathtwo & ".pdf" _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False

    FilePathone = "http://intranet/Pricing%20and%20Rates/Floor%20Matrices/FIFOs/" & Format(Now(), "YYYYMMDD") & "%20-%20Gas%20Rates.pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    FilePathone _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False

    wbtemp.Sheets("Sheet1").Range("B5:L9").Copy

    Set testcode = Workbooks.Open(FileName:="G:\Betts\ReturnOnInvestment_Master_Backup Testcode.xlsm", UpdateLinks:=3)


    testcode.Sheets("Floor Pricing").Range("A44").PasteSpecial xlPasteValues

    testcode.Close savechanges:=True
    wbtemp.Close
    Kill (FilePath)

   End If
  End If

我认为它必须与代码不一定,而是如何附加excel文档。我不太熟悉excel文档可以附加的不同方式,以便它被旁路。

非常感谢任何帮助。我是初学者,总是欢迎更多的解释。

提前谢谢你,

1 个答案:

答案 0 :(得分:2)

所有归功于Rory,

我还有一个&#34;退出&#34;在我的for循环中,它导致循环在拾取jpeg图像后退出,因此它似乎没有读取excel文档。固定For循环:

 If Msg.Attachments.Count <> 0 Then
        For Each msgattach In Msg.Attachments
        If Right(msgattach.FileName, 5) = ".xlsx" Then
            FilePath = "G:\Betts\Floor Matricies\FIFOs\" & Format(Now(), "YYYYMMDD") & " - " & "Gas Rates" & Right(msgattach.FileName, 5)
            msgattach.SaveAsFile FilePath
        End If
   Next
 End If

祝大家好运。再次感谢你。