Question on Password input

S

sammy830

New Member
Joined
Feb 6, 2019
Messages
5
Hello, I am using the following .vbs script to open, run, save and quit excel:

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open _
("my_excel_workbook")
objExcel.ActiveWorkbook.Save
objExcel.Quit

What happens in the excel sheet is a macro is initialzied upon opening the file. I have the macro password protected so that it can only run with the password. I was hoping to have the above .vbs script input the password into the following section of code:
Dim password As Variant
password = Application.InputBox("Enter Password", "Password Protected")

Select Case password
Case Is = False
'do nothing
Case Is = "easy"
MY CODE
Case Else
MsgBox "Incorrect Password"
End Select

Any help here would be greatly appreciated. Also, if you have any questions feel free to reach out!
 

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.
Sort by date Sort by votes
Hi and welcome to MrExcel!
Try this VBScript:
Rich (BB code): 
Dim objExcel, objWorkbook, password
 
password = InputBox("Enter Password", "Password Protected")
 
Select Case password
 
  Case False
    'do nothing
 
  Case "easy"
    'MY CODE
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("my_excel_workbook")
    'objExcel.Visible = True
    objWorkbook.Save
    objWorkbook.Close False
    objExcel.Quit
    Set objWorkbook = Nothing
    Set objExcel = Nothing
 
  Case Else
    MsgBox "Incorrect Password"
 
End Select
 
Last edited:
Upvote 0
Thanks for the help. I think I need to be more clear. What this script is doing is just adding another password protection on top of what I already have. The first script I posted was a .txt file saved as a .vbs, so it can be ran by windows scheduler in the background. What this does is initialize the following:
Code: 
Private Sub Workbook_Open()
    Dim password As Variant
    password = Application.InputBox("Enter Password", "Password Protected Macro")
    Select Case password
        Case Is = False
            'do nothing
        Case Is = "rbi"
            Dim xRgDate As Range
            Dim xRgSend As Range
            Dim xRgCopy As Range
            Dim xRgText As Range
            Dim xOutApp As Object
            Dim xMailItem As Object
            Dim xLastRow As Long
            Dim vbCrLf As String
            Dim xMailBody As String
            Dim xRgDateVal As String
            Dim xRgSendVal As String
            Dim xRgCopyVal As String
            Dim xMailSubject As String
            Dim i As Long
            On Error Resume Next
            Set xRgDate = Range("D11:D10000")
            If xRgDate Is Nothing Then Exit Sub
            Set xRgSend = Range("G11:G10000")
            If xRgSend Is Nothing Then Exit Sub
            Set xRgCopy = Range("H11:H10000")
            If xRgCopy Is Nothing Then Exit Sub
            Set xRgText = Range("C11:C10000")
            If xRgText Is Nothing Then Exit Sub
            xLastRow = xRgDate.Rows.Count
            Set xRgDate = xRgDate(1)
            Set xRgSend = xRgSend(1)
            Set xRgCopy = xRgCopy(1)
            Set xRgText = xRgText(1)
            Set xOutApp = CreateObject("Outlook.Application")
            For i = 1 To xLastRow
            xRgDateVal = ""
            xRgDateVal = xRgDate.Offset(i - 1).Value
                If xRgDateVal <> "" Then
                If CDate(xRgDateVal) - Date = 60 Then
                    xRgSendVal = xRgSend.Offset(i - 1).Value
                    xMailSubject = ("You have an Action Item due in 60 Days!")
                    vbCrLf = "<br><br>"
                    xMailBody = "<HTML>******>"
                    xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
                    xMailBody = xMailBody & "The following action items is coming due: " & xRgText.Offset(i - 1).Value & vbCrLf
                    xMailBody = xMailBody & "</BODY></HTML>"
                    Set xMailItem = xOutApp.CreateItem(0)
                    With xMailItem
                        .Subject = xMailSubject
                        .To = xRgSendVal
                        .HTMLBody = xMailBody
                        .Display
                        '.Send
                    End With
                    ElseIf CDate(xRgDateVal) - Date = 30 Then
                    xRgSendVal = xRgSend.Offset(i - 1).Value
                    xMailSubject = ("You have an Action Item due in 30 Days!")
                    vbCrLf = "<br><br>"
                    xMailBody = "<HTML>******>"
                    xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
                    xMailBody = xMailBody & "The following action item is coming due: " & xRgText.Offset(i - 1).Value & vbCrLf
                    xMailBody = xMailBody & "</BODY></HTML>"
                    Set xMailItem = xOutApp.CreateItem(0)
                    With xMailItem
                        .Subject = xMailSubject
                        .To = xRgSendVal
                        .HTMLBody = xMailBody
                        .Display
                        '.Send
                    End With
                    ElseIf CDate(xRgDateVal) - Date <= 0 And CDate(xRgDateVal) - Date < 0 Then
                    xRgSendVal = xRgSend.Offset(i - 1).Value
                    xRgCopyVal = xRgCopy.Offset(i - 1).Value
                    xMailSubject = ("You have an Action Item Overdue!")
                    vbCrLf = "<br><br>"
                    xMailBody = "<HTML>******>"
                    xMailBody = xMailBody & "Dear " & xRgSendVal & " & " & xRgCopyVal & vbCrLf
                    xMailBody = xMailBody & "The following action item is overdue : " & xRgText.Offset(i - 1).Value & vbCrLf
                    xMailBody = xMailBody & "</BODY></HTML>"
                    Set xMailItem = xOutApp.CreateItem(0)
                    With xMailItem
                        .Subject = xMailSubject
                        .To = xRgSendVal
                        .Cc = xRgCopyVal
                        .HTMLBody = xMailBody
                        .Display
                        '.Send
                    End With
                    Set xMailItem = Nothing
                End If
            End If
            Next
            Set xOutApp = Nothing
        Case Else
        MsgBox "Incorrect Password"
    End Select
End Sub

What I need is that initial .vbs/.txt file to automatically input the password into password = Application.InputBox("Enter Password", "Password Protected Macro")
 
Last edited by a moderator:
Upvote 0
You may use this code in ThisWorkbook module instead:
Rich (BB code): 
Private Sub Workbook_Open()
  Dim Password
  If Application.UserControl Then
    ' Loaded by user
    Password = Application.InputBox("Enter Password", "Password Protected Macro")
  Else
    ' Loaded by VBScript
    Password = "easy"
  End If
  'MsgBox Password
  ' Your code ...
End Sub
It asks the password for a user and automatically set password for VBScript.

But for me saving workbook with file password is more secure.
Then code line in VBS is: Set objWorkbook = objExcel.Workbooks.Open("my_excel_workbook", Password:="easy")
 
Last edited:
Upvote 0
Glad it has helped!
(y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBS to use on Open Workbooks
Replies
0
Views
439
agentkramr
A
B
  • Question
help with a vbs script
Replies
3
Views
434
Joe4
Joe4
R
  • Question
Mail merge to insert the picture in the mail body and schedule the email
Replies
0
Views
756
rafeek4u
R
O
  • Question
Outlook VBA to detect non-password protected attachements
Replies
0
Views
912
Oredo
O
P
  • Question
Incorrect Password still runs macro
Replies
3
Views
232
PaulWJ
P

Forum statistics

Threads
1,214,520
Messages
6,120,017
Members
448,937
Latest member
BeerMan23

Share this page

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