Duplicate workbook then delete named modules from the duplicate workbook

StillUnderstanding

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

I wonder if anyone can help me with a problem I am stuck on. I am using code that allows me to duplicate my workbook and then save it to another location. What I am trying to do is delete some of the modules from the duplicated workbook before saving.

I am using the below code and everything works apart from the module deleting part. Can anyone please help me with this please?


VBA Code:
 'Create duplicate in temp folder.
    ThisWorkbook.SaveCopyAs strTempFolderPath & "2022a.xlsb"
    
    Application.Wait (Now + TimeValue("0:00:05"))
    '2) ----------> Open the duplicate file
    Set wbDuplicate = Workbooks.Open(strTempFolderPath & "2022a.xlsb")
  
   Dim vbCom As Object

   'Disabling the alert message
Application.DisplayAlerts = False
'Ignore errors
On Error Resume Next
'Delete the component
wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents("test", "Module111", "Module3")
On Error GoTo 0
'Enabling the alert message
Application.DisplayAlerts = True

         On Error GoTo 0
    'Next
    
    '3) ----------> Close all tabs except the following:
     '- Import Core Data
    '- SendMail
    '- Test CP Weekly
    Worksheets("Lookup").Unprotect

    For Each shSheet In wbDuplicate.Sheets
        If shSheet.Name <> "TAB 1" And shSheet.Name <> "TAB2" And shSheet.Name <> "Tab3" Then
            shSheet.Visible = xlVeryHidden
            Sheets("Tab3").Visible = False
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,523
Office Version
  1. 365
Platform
  1. Windows
I haven't tried it myself, but see if this helps . . .

 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

StillUnderstanding

Board Regular
Joined
Jan 30, 2021
Messages
76
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I haven't tried it myself, but see if this helps . . .

@Domenic Thanks for your help. I can confirm that I got it to open the VBA and delete the parts that I did not want.

Works perfect and I managed to get it to also delete a number of tabs that are not required.

Here is the code should anyone like to use it or feels I could improve on it!



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
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,523
Office Version
  1. 365
Platform
  1. Windows
That's great, I'm glad I could help. And thanks for letting us know.

Cheers!
 

Forum statistics

Threads
1,176,089
Messages
5,901,335
Members
434,886
Latest member
qazibelal

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
Top