2016-09-28 61 views
0

我有几个例程,我试图去一起工作。前两个找到用户计算机上的outlook.exe文件,我希望第三个如果尚未运行,则使用该文件打开Outlook。我遇到的问题是能够将该文件的路径传递给第三个例程。这是我的代码。任何帮助,将不胜感激。Excel VBA传递文件路径到例程打开Outlook

Sub GetSubFolders() 

     Dim fso As New FileSystemObject 
     Dim f As Folder, sf As Folder 
     Dim myFile As File 

     On Error Resume Next 

     Set f = fso.GetFolder("C:\Program Files\") 

     For Each myFile In f 
     Next 

     For Each sf In f.SubFolders 
      Call Recursive(sf) 
     Next 

     Set f = fso.GetFolder("C:\Program Files (x86)\") 

     For Each myFile In f 
     Next 

     For Each sf In f.SubFolders 
      Call Recursive(sf) 
     Next 

    End Sub 
    Sub Recursive(sf As Folder) 
     Dim fso As New FileSystemObject 
     Dim f, nsf As Folder 
     Dim myFile As File 
     Dim s As String 
     Dim ofile As String 

     On Error Resume Next 

     Set f = fso.GetFolder(sf) 

     For Each myFile In f.Files 
      If Right(myFile, 11) = "outlook.exe" Then 
      Range("A1").Value = myFile.Path 
      Call outlook 
      End 
      End If 
     Next 
     For Each nsf In f.SubFolders 
      Recursive nsf 
     Next 


    End Sub 
    Sub outlook() 
    Const PATH_TO_OUTLOOK = """C:\Program Files\Microsoft Office 15\root\office15\outlook.exe""" 
    Const SHOW_MAXIMIZED = 3 
    Const MINIMIZE = 1 

    Dim oShell, oOutlook As Object 
    On Error Resume Next 
    Set oOutlook = GetObject(, "Outlook.Application") 
    Set oShell = CreateObject("WScript.Shell") 
    On Error GoTo 0 

    If oOutlook Is Nothing Then 

     ' Open Outlook 
     oShell.Run PATH_TO_OUTLOOK, SHOW_MAXIMIZED, False 

     On Error Resume Next 

     ' Grab a handle to the Outlook Application and minimize 
     Set oOutlook = WScript.CreateObject("Outlook.Application") 
     WScript.Sleep (10000) 
     oOutlook.ActiveExplorer.WindowState = SHOW_MAXIMIZED 

     ' Loop on error to account for slow startup in which case the 
     ' process and/or the main Outlook window is not available 
      Err.Clear 
      WScript.Sleep (10000) 
      Set oOutlook = Nothing 
      Set oOutlook = CreateObject("Outlook.Application") 
      oOutlook.ActiveExplorer.WindowState = MINIMIZE 


     Set oOutlook = Nothing 
     Set oShell = Nothing 
    End If 
    End Sub 
+0

什么是找到Outlook可执行的目的是什么?如果它安装在机器上,所有你需要做的就是'CreateObject(“Outlook.Application”)',然后将它设置为'.Visible'。 – Comintern

+0

也许我正在讨论这个错误,但我认为,因为不同的用户可能安装了不同版本的Office,有些可能有32位和64位,可执行文件将位于不同的位置。我发布的Outlook例程完美适用于我的机器,但很可能不适用于每个将使用此功能的用户。 – DDietz

回答

1

究竟是共产国际的评论 -

Sub Test() 

    Dim oOL As Object 
    Dim ns As Object 
    Dim fldr As Object 

    Set oOL = CreateOL 

    Set ns = oOL.GetNameSpace("MAPI") 
    Set fldr = ns.GetDefaultFolder(6) 'olFolderInbox 
    fldr.display 

End Sub 

Public Function CreateOL() As Object 

    Dim oTmpOL As Object 

    On Error GoTo ERROR_HANDLER 

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    'Creating an instance of Outlook is different from Excel. ' 
    'There can only be a single instance of Outlook running, ' 
    'so CreateObject will GetObject if it already exists.  ' 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Set oTmpOL = CreateObject("Outlook.Application") 

    Set CreateOL = oTmpOL 

    On Error GoTo 0 
    Exit Function 

ERROR_HANDLER: 
    Select Case Err.Number 

     Case Else 
      MsgBox "Error " & Err.Number & vbCr & _ 
       " (" & Err.Description & ") in procedure CreateOL." 
      Err.Clear 
    End Select 

End Function 
+0

我不得不承认我首先不是vba专家。我试过了你提供的代码,Outlook应用程序打开几秒钟,然后关闭。我最初发布的Outlook例程完全按照我的想法工作,但我需要它为32位或64位办公室的用户工作。也许我错了,但我正在学习。有什么办法可以让myFile作为PATH_TO_OUTLOOK常量或类似的东西传递给Outlook例程吗? – DDietz

+0

我已经更新了代码,以便代码完成后可以看到收件箱。要将myFile传递给你的Outlook例程,你需要将myFile设置为整个模块可见的变量(在模块顶部声明),或者将你的过程名更新为Sub Outlook(PATH_TO_OUTLOOK AS String) '然后当你用'Outlook myFile'或'CALL Outlook(myFile)'调用它时(不需要调用关键字)。 –

+0

非常感谢您的帮助!在你的帮助下,我终于能够按照我想要的方式工作。我确定它不是那么精细,但它工作正常! – DDietz