从 vba 打开其他应用程序答案

【问题标题】：Open other application from vba从 vba 打开其他应用程序
【发布时间】：2018-02-28 10:35:57
【问题描述】：

我正在开发一个宏来打开一个文件（可能已经打开）并用新名称保存，然后在 excel 中从 vba 打开新文件。

此文件可以是Powerpoint、mathcad、visio、word等（也可以是dotx等模板文件）

所以我的想法是：

我首先需要弄清楚应用程序是否打开，
那么我需要确定文件是否打开，
然后用新的文件名保存它。
打开新文档
浏览文档并将自定义变量转储到数据库中，从数据库中填充自定义变量（以下代码中未显示，单独的模块）

激活新文档以便用户对其进行编辑。

Public Sub saveAsVBADocument(filenameNew As String, fileNameOld As String, applicationType As String)
Dim objectApplication As Object
Dim documentApplication As Object

On Error Resume Next
Set objectApplication = GetObject(, applicationType)
On Error GoTo 0

If objectApplication Is Nothing Then
    Set objectApplication = CreateObject(applicationType)
End If


objectApplication.Visible = True


On Error Resume Next
Set documentApplication = objectApplication.Workbooks(FileHandling.GetFilenameFromPath(fileNameOld)) 'Excel
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'Word
Set documentApplication = objectApplication.WorkSheets(FileHandling.GetFilenameFromPath(fileNameOld)) 'Mathcad
Set documentApplication = objectApplication.Presentations(FileHandling.GetFilenameFromPath(fileNameOld)) 'PowerPoint
Set documentApplication = objectApplication.Projects(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Project "Msproject.Application"
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Visio "Visio.Application"


If documentApplication Is Nothing Then
    Set documentApplication = objectApplication.FileOpen(fileNameOld) ' add  read only
End If

documentApplication.SaveAs filename:=filenameNew

Set objectApplication = Nothing
Set documentApplication = Nothing

End Sub

处理所有 vba 可接受的文档类型的可能解决方案是什么？

【问题讨论】：

你能解释一下这个的总体目的吗？你想达到什么目的？你为什么不直接复制那个文件而不是打开和另存为？

标签： vba excel

【解决方案1】：

您可以使用 GetObject("Filename") 直接在其应用程序中打开文件。所以像这样的东西可以打开任何在 Windows 注册表中有扩展名的文件。那将是大多数文件类型；当然是 Office 应用程序。您是否能够使用 SaveAs 将取决于这些应用程序是否支持 OLE Server（这意味着它们具有公开的编码接口）。同样，所有 Office 应用程序都支持这一点。

如果在注册表中找不到文件扩展名的应用程序，您可能需要进行一些错误处理。当然，如果文件名不存在。

我的示例仅适用于 Excel 和 Word - 您应该能够填写其他内容。我的代码确保文件对用户可见且可用，因为这样更容易排除故障。当然，一旦一切顺利，您就可以改变这一点。

Sub OpenFileInUnknownApp()
    Dim objFile As Object
    Dim objApp As Object
    Dim sPath As String, sExt As String
    Dim sFileName As String
    Dim sAppName As String
    Dim snewfilename As String

    sPath = "C:\Test\"
    sFileName = sPath & "Quote.docx" 'RngNames.xlsx"
    snewfilename = sPath & "NewName"

    '''Open the file in its application
    Set objFile = GetObject(sFileName)
    Set objApp = objFile.Application
    sAppName = objApp.Name

    Select Case sAppName
        Case Is = "Microsoft Excel"
            Dim wb As Excel.Workbook
            sExt = "xlsx"
            objApp.Visible = True
            Set wb = objFile
            wb.Activate
            wb.Windows(1).Visible = True
            objApp.UserControl = True 'so that it "lives" after the code ends
            objApp.Activate
            wb.SaveAs "sNewFileName" & sExt
        Case Is = "Microsoft Word"
            Dim doc As word.Document
            sExt = "docx"
            objApp.Visible = True
            Set doc = objFile
            objApp.Activate
            doc.SaveAs2 "sNewFileName" & sExt
        Case Else
    End Select
    Set objFile = Nothing
    Set objApp = Nothing
End Sub

【讨论】：