Run a macro in a workbook using a separate instance of Excel

StillUnderstanding

Board Regular
Joined
Jan 30, 2021
Messages
80
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

I am running the below code in a workbook and it is duplicating my VBA protected workbook into a separate instance of Excel, it works really well. Once it duplicates the workbook in the separate instance it then delete some macros and also tabs. @Domenic was amazing at helping me to get this working!

I am trying to then have it run 3 macros that are in the duplicated workbook but I just can't get it to work. I tried the below but it keeps doing it on the original workbook.

I tried to use </>Call NameOfMacro</> as well as </> Application.Run "'Another Workbook.xlsm'!NameOfMacro"</> but it won't call the duplicate book that is saved in the C:\Temp folder and open it in the new excel instance.

Below is the code without the call function as I just can't get it to work. I would be grateful if anyone could help please!


VBA Code:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Dim Ret As Long, ChildRet As Long, OpenRet As Long
Dim strBuff As String, ButCap As String
Dim MyPassword As String

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5

Sub Unlock_Upload()

'Exit Admin mode and upload to sharepoint':
‘The file will do the below
'1) Duplicate the file to location c:\
'2) Open in separate instance and unlock
'3) Remove tabs from the workbook
'4) Remove Modules from the project
'5) Close all tabs except the following:
'- Looking
'6) Save to sharepoint and close duplicate file.

   ' On Error GoTo Errorhandler
    
    Dim strTempFolderPath As String
    Dim wbDuplicate As Workbook
    Dim shSheet As Worksheet
    Dim strSharePointPath As String
    
    
    Application.ScreenUpdating = False
  Application.Calculation = xlAutomatic
 Application.DisplayAlerts = False 'Disables file overwrite warnings.
Application.DisplayStatusBar = True
    Application.EnableEvents = False
    
    '1) ----------> Duplicate the file to a temp folder in C:\
    'Pick the folder path from C100 in 'Admin' sheet.
    'If C100 does not contain the path, then set it to C:\Temp.
    strTempFolderPath = Range("C100").Value
    
    If strTempFolderPath = "" Then strTempFolderPath = "C:\Temp\o22"
    
    If Dir(strTempFolderPath, vbDirectory) = "" Then
        MkDir strTempFolderPath
    End If
    
    strTempFolderPath = strTempFolderPath & "\"
    
    'Create duplicate in temp folder.
    ThisWorkbook.SaveCopyAs strTempFolderPath & "o22.xlsb"
    
    '2) ----------> Open in separate instance and unlock
    
    Dim xlAp As Object, oWb As Object
    
    Set xlAp = CreateObject("Excel.Application")
    
    xlAp.Visible = True
    
    '~~> Open the workbook in a separate instance
    Set oWb = xlAp.Workbooks.Open("C:\Temp\o22\o22.xlsb")

    '~~> Launch the VBA Project Password window
    '~~> I am assuming that it is protected. If not then
    '~~> put a check here.
    xlAp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

    '~~> Your passwword to open then VBA Project
    MyPassword = "my password goes here"
    
    '~~> Get the handle of the "VBAProject Password" Window
    Ret = FindWindow(vbNullString, "VBAProject Password")
    
    If Ret <> 0 Then
        'MsgBox "VBAProject Password Window Found"
        
        '~~> Get the handle of the TextBox Window where we need to type the password
        ChildRet = FindWindowEx(Ret, ByVal 0&, "Edit", vbNullString)
        
        If ChildRet <> 0 Then
            'MsgBox "TextBox's Window Found"
            '~~> This is where we send the password to the Text Window
            SendMess MyPassword, ChildRet
        
            DoEvents
        
            '~~> Get the handle of the Button's "Window"
            ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
            
            '~~> Check if we found it or not
            If ChildRet <> 0 Then
                'MsgBox "Button's Window Found"
    
                '~~> Get the caption of the child window
                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                GetWindowText ChildRet, strBuff, Len(strBuff)
                ButCap = strBuff
    
                '~~> Loop through all child windows
                Do While ChildRet <> 0
                    '~~> Check if the caption has the word "OK"
                    If InStr(1, ButCap, "OK") Then
                        '~~> If this is the button we are looking for then exit
                        OpenRet = ChildRet
                        Exit Do
                    End If
    
                    '~~> Get the handle of the next child window
                    ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                    '~~> Get the caption of the child window
                    strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                    GetWindowText ChildRet, strBuff, Len(strBuff)
                    ButCap = strBuff
                Loop
    
                '~~> Check if we found it or not
                If OpenRet <> 0 Then
                    '~~> Click the OK Button
                    SendMessage ChildRet, BM_CLICK, 0, vbNullString
                    SendKeys "{ENTER}"
 

'3) ----------> Remove tabs from the workbook
oWb.Sheets("Sheet1").Delete
oWb.Sheets("Sheet2").Delete
oWb.Sheets("Sheet3").Delete
oWb.Sheets("Index").Delete
oWb.Sheets("Sheet12").Delete
                  
    '4) ----------> Remove Modules from the project
         Dim modulesToRemove As Variant
    Dim i As Long
    oWb.Application.DisplayAlerts = False
 
   modulesToRemove = Array("Module1", "module2", "Module3”)
    
    'On Error Resume Next
    For i = LBound(modulesToRemove) To UBound(modulesToRemove)
        With oWb.VBProject.VBComponents
            .Remove .Item(modulesToRemove(i))
        End With
    Next i
    On Error GoTo 0
    '5) ----------> Close all tabs except the following:
    '- Looking

    Worksheets("Looking").Unprotect
    Worksheets("Admin").Visible = False

Sheets("Admin").Visible = False

    For Each shSheet In oWb.Sheets
        If shSheet.Name <> "Looking" And shSheet.Name <> "Admin" Then
            shSheet.Visible = xlVeryHidden
            
            
        End If
    Next shSheet
    
    '6) ----------> Save to sharepoint and close duplicate file.
    oWb.Sheets("Admin").Visible = False
    oWb.Save 'As "Onboarding Tracker"
    oWb.SaveAs "https://myown.sharepoint.com/folder " & "/" & "o22.xlsb", xlExcel12
    oWb.Close True
    Application.DisplayAlerts = False
 
    
    MsgBox "File uploaded to SharePoint successfully.", , "Exit Admin Mode"
    
                Else
                    MsgBox "The Handle of OK Button was not found"
                End If
            Else
                 MsgBox "Button's Window Not Found"
            End If
        Else
            MsgBox "The Edit Box was not found"
        End If
    Else
        MsgBox "VBAProject Password Window was not Found"
        
      
    End If
    Sheets("Admin").Visible = True
End Sub

Sub SendMess(Message As String, hwnd As Long)
    Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Forum statistics

Threads
1,214,832
Messages
6,121,849
Members
449,051
Latest member
excelquestion515

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top