Copying a Sheet to new workbook does not copy VB Project Settings

Question

I am saving Sheet2 to a new workbook by copying it, but doing so un-protects my VBA code present in Sheet2 in the new workbook. Original workbook has the VB Project protected.

Any suggestions on how to save just Sheet2 with the VB Project settings?

CODE to unlock VBA:

Sub UnlockVBA(NewWbPath As String)
    Dim oWb As Object, xlAp As Object

    Set xlAp = CreateObject("Excel.Application")

    xlAp.Visible = True

    '~~> Open the workbook in a separate instance
    Set oWb = xlAp.Workbooks.Open(NewWbPath)

    '~~> 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 = "pa$$w0rd"

    '~~> 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
                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
End Sub

Do you have to copy/move sheet two to the new workbook? Consider setting up a template workbook and copy/pasting the content into the template. This way you can lock the template workbook's VBProject. — ARich, Nov 06 '13 at 19:20
@ARich template would not be feasible as this workbook is used by 30-40 users on different machines with different access rules to network/shared drive. I'll have to save the template on each users local drive which will be a maintenance nightmare — user793468, Nov 06 '13 at 19:38

score 1 · Accepted Answer · edited May 08 '18 at 21:48

1

The VBA code of a sheet or module is never protected individually but the entire VBA Project is protected.

The simple way to achieve what you want is to use Workbook.SaveCopyAs and then open that copy and delete the unwanted sheets.

See this MSDN article on Workbook.SaveCopyAs Method

In case that link dies, posting a screenshot of that page.

enter image description here

EDIT

This will do what you want. However this will also copy across any modules as well. You will have to delete them separately. For that you may see Deleting A Module From A Project HERE

Tried and Tested

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Sub Sample()
    Dim NewWb As Workbook
    Dim ws As Worksheet
    Dim shName As String, NewWBName As String

    '~~> Name of the new workbook
    NewWBName = "Output.xlsm"
    '~~> Name of the sheet you want to copy across
    shName = "Sheet1"

    '~~> Create a copy in the users temp directory
    ThisWorkbook.SaveCopyAs TempPath & NewWBName

    '~~> Open the workbook
    Set NewWb = Workbooks.Open(TempPath & NewWBName)

    '~~> Delete unwanted sheets
    For Each ws In NewWb.Worksheets
        If ws.Name <> shName Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next

    '~~> Save the new file at desired location
    NewWb.SaveAs "C:\Output.xlsm", 52

    '~~> Delete temp file
    Kill TempPath & NewWBName
End Sub

Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

edited May 08 '18 at 21:48

Community

1
1

answered Nov 06 '13 at 19:18

Siddharth Rout

147,039
17
206
250

Anyway to delete modules when VB Project is protected? – user793468 Nov 06 '13 at 22:29
do u know the password? – Siddharth Rout Nov 07 '13 at 06:26
Yes, I know the password – user793468 Nov 07 '13 at 14:48
See [THIS](http://stackoverflow.com/questions/16174469/unprotect-vbproject-from-vb-code/16176557#16176557) then :) – Siddharth Rout Nov 07 '13 at 15:37
I tried this earlier, Always prompts the message "VBAProject Password Window was not Found". The workbook's VBA project is protected, It shows the window to enter VBA Password in and then "VBAProject Password Window was not Found" – user793468 Nov 07 '13 at 16:56
It's not possible :) Can you post a screenshot of the password window. I have a feeling that the caption is different. Different regional setting I guess? – Siddharth Rout Nov 07 '13 at 16:58
Here is what I am doing. I am saving an excel file with modules and userform to a temp location, Then I am passing this newly saved file at temp locations path to "UnlockVBA(NewWbPath As String)". I set the workbook to the file and then pass the password to unlock the VBAProject. I see the VBAProject Password screen popup, not the VBAProject - Project Properties window. I have modified your code and posted above for more clarity – user793468 Nov 07 '13 at 17:57
While debugging, at line "Ret = FindWindow(vbNullString, "VBAProject Password")" if I manually click on the password window then it identifies it. Shouldn't setting workbook(set oWb = xlAp.Workbooks.Open("C:\..") take care of the focus? – user793468 Nov 07 '13 at 18:42
`FindWindow` doesn't require the window to be in focus. There must be some other problem. Let me go through your code. – Siddharth Rout Nov 07 '13 at 18:47
Do this. Add `Doevents` after this line `xlAp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute` Now check – Siddharth Rout Nov 07 '13 at 18:48
Still does not recognize it – user793468 Nov 07 '13 at 18:55
Could it be because we are trying to unlock VBA in some other workbook ? – user793468 Nov 07 '13 at 18:59

Copying a Sheet to new workbook does not copy VB Project Settings

1 Answers1