如何打开从我的邮箱下载并在Winzip中成功提取的Excel文件?

时间:2013-11-29 13:05:18

标签: excel vba excel-vba

我正在做一个我满足2个条件的项目。我必须从我的邮箱下载Winzip附件,然后成功解压缩然后打开该文件。我已完成前两部分,但我无法打开该文件。问题在于文件的名称。我无法在宏中指定文件的名称。以下是使用的代码:

Sub FebAttachment_Click()
Const olFolderInbox As Integer = 6
Const AttachmentPath As String = "D:\Documents and Settings\rahul.baskaran\Desktop\"
Dim oApp As Object, ONS As Object, OInb As Object
Dim OItem, OAtch As Object
Dim OFind As Object
Dim OMail As Object


Set oApp = GetObject(, "Outlook.application")
Set ONS = oApp.GetNamespace("MAPI")
Set OInb = ONS.Folders("Archive Folders").Folders("BIZOPS").Folders("2014.02")
Set OMail = OInb.Items

For Each OItem In OInb.Items

    If OItem.Attachments.Count <> 0 Then
        For Each OAtch In OItem.Attachments
            OAtch.SaveAsFile AttachmentPath & OAtch.Filename
            Exit For
        Next
    Else
        MsgBox "The mail doesn't have an attachment"
        End If
Exit For
Next`

Dim FSO As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As Variant
Dim EXCELApplication As Object



 Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                    MultiSelect:=False)

If Fname = False Then
    'Do nothing
Else

    DefPath = "D:\Documents and Settings\rahul.baskaran\Desktop\"
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    Set oApp = CreateObject("Shell.Application")

    oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).Items
    DoEvents


Set EXCELApplication = CreateObject("Excel.Application")
EXCELApplication.Workbooks.Open (DefPath & "\22 ABC Feb BVA as of 25th-Nov-13 Sigma .xlsb")
EXCELApplication.Visible = True

 End Sub

使用此代码,一切正常。但在下面的行。我想自动化文件的名称,然后打开文件。我无法执行此操作。

EXCELApplication.Workbooks.Open (DefPath & "\22 ABC Feb BVA as of 25th-Nov-13 Sigma .xlsb")

有人可以用以下2分来帮助我吗?

1)是否可以在不使用Application.GetOpenFilename函数手动选择文件的情况下提取文件?

2)我希望提取的文件在成功提取后自动打开。任何其他编码方法也是受欢迎的。

1 个答案:

答案 0 :(得分:1)

该行的问题是额外的\

DefPath已评估为"D:\Documents and Settings\rahul.baskaran\Desktop\",因此DefPath & "\22 ABC Feb BVA as of 25th-Nov-13 Sigma .xlsb"将为您提供

D:\Documents and Settings\rahul.baskaran\Desktop\\22 ABC Feb BVA as of 25th-Nov-13 Sigma .xlsb"

请注意\\之前的22?将您的代码更改为

EXCELApplication.Workbooks.Open (DefPath & "22 ABC Feb BVA as of 25th-Nov-13 Sigma .xlsb")