Page tree

Welcome to FreeSoftwareServers Confluence Wiki

Skip to end of metadata
Go to start of metadata

https://stackoverflow.com/questions/63058197/how-to-add-open-workbook-to-application-workbooks-collection-and-or-interact-w

Public Sub Copy_External_WB(WONum)
 Dim xlApp As Excel.Application, xlBook As Worksheet, i As Long

 If ActiveWorkbook.Name = "Book1" Then
 For i = 2 To 10
   On Error Resume Next
   Set xlApp = GetObject("Book" & i).Application
   If Err.Number = -2147221020 Then
        Err.Clear: On Error GoTo 0
   Else
        On Error GoTo 0
        Exit For
   End If
 Next i
 Else
  For i = 1 To 10
   On Error Resume Next
   Set xlApp = GetObject("Book" & i).Application
   If Err.Number = -2147221020 Then
        Err.Clear: On Error GoTo 0
   Else
        On Error GoTo 0
        Exit For
   End If
 Next i
 End If

 If Not xlApp Is Nothing Then
    Set xlBook = xlApp.Worksheets(1)
    Debug.Print xlApp.hWnd, Application.hWnd
 Else
    MsgBox "No Excel session with Book(1 - 10) open could be found..."
    xlApp.Quit: Exit Sub
 End If
 
 xlBook.SaveAs Filename:=Environ("TEMP") & "\" & WONum & ".xlsx"

 xlApp.DisplayAlerts = False
 xlApp.Quit
 xlApp.DisplayAlerts = True
 Set xlApp = Nothing
 Call OpenWOOnHold(Environ("TEMP") & "\" & WONum & ".xlsx")
End Sub
Public Sub OpenWOOnHold(FileStr)
Dim wbk1 As Workbook, wbk2 As Workbook
    Set wbk1 = ActiveWorkbook
    Set wbk2 = Workbooks.Add(FileStr)
    wbk2.Worksheets(1).Copy After:=wbk1.Sheets(1)
    wbk2.Close SaveChanges:=False
    SetAttr FileStr, vbNormal
    Kill FileStr
End Sub
Public Function FileExists(ByVal FileToTest As String) As Boolean
   FileExists = (Dir(FileToTest) <> "")
End Function
Public Sub DeleteFile(ByVal FileToDelete As String)
   If FileExists(FileToDelete) Then 'See above
      ' First remove readonly attribute, if set
      'SetAttr FileToDelete, vbNormal
      ' Then delete the file
      Kill FileToDelete
   End If
End Sub
  • No labels