VB help

The code below appears to copy sheet 3 only and insert this into an outlook file. The problem I get is that with the new 'file' the vb password is lost and it is possible to view the vb code. Is it possible to amend the code so that the VB password remains intact or if not possible a new password is added.

Many thanks for your help, it is much appricated.


Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook
    Dim Sht1 As Worksheet, strTempShtname As String, TmpSheet As Worksheet
    Dim pass As String, obj As OLEObject

   
    pass = InputBox("please enter a password")
   
    If Len(Trim(pass)) = 0 Then GoTo ExitNow
   
    If pass <> "gaz5" Then
        MsgBox "Incorrect Password"
        Exit Sub
   
    End If
   
    Application.DisplayAlerts = False
   
    On Error GoTo Err
    Dim wbk As Workbook
'Save temporary file so that it can be attached to an email
   OutFile = Environ$("temp") & "\" & Format(Now, "DD-MM-YYYY") & " Copy" & ".xls"  'construct temp file name
   If Dir(OutFile) <> "" Then Kill OutFile   ' delete any previously saved temp file
   ' copy sheet to new workbook
   Sheet3.Copy
   Set wbk = ActiveWorkbook
   
   wbk.SaveAs Filename:=OutFile  ' save temp file
   
   ' construct email, attaching temp file to email
   Set OutApp = CreateObject("Outlook.Application")
   OutApp.Session.Logon
   Set OutMail = OutApp.CreateItem(0)
   
   With OutMail
      .Subject = "new file "
      .Body = "please see attachment"
      .Attachments.Add OutFile
      .Display
   End With
   
   Set OutMail = Nothing
   Set OutApp = Nothing
   
   wbk.Close False
   If Dir(OutFile) <> "" Then Kill OutFile   ' delete the temp file
   
ExitNow:
    Application.DisplayAlerts = True
   
    Exit Sub
Err:
    MsgBox Err.Description
End Sub