从vba

Question

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

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

所以我的想法是：

1. 我首先要弄清楚应用程序是否打开，
2. 然后我想知道文件是否打开，
3. 然后用新文件名保存。
4. 打开新文档
5. 浏览文档并将自定义变量转储到数据库中，从数据库填充自定义变量（未在下面的代码中显示，单独的模块）

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

   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可接受的文档类型的可能解决方案是什么？

Answer 1

您可以使用GetObject（“Filename”）直接在其应用程序中打开文件。所以像这样的东西可以打开任何在Windows注册表中具有扩展名的文件。这将是大多数文件类型;肯定是Office应用程序。您是否能够使用SaveAs将取决于这些应用程序是否支持OLE服务器（意味着它们具有暴露的编码接口）。同样，所有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