Help with VBA autofill name and password.

[RedOctoberKnight]

Hello all,

I inherited an Excel file at work that opens up a separate non Excel program and then copies and pastes the data to the excel file. Right now the VBA code opens up the program and asks for the username and password to be entered and once entered pressing okay will run the code to copy and paste the data from the program (OTIS). (When OTIS opens up it automatically copies the data to the clipboard. The excel progam simply takes that info from the clipboard and pastes it into Excel.) Im hoping I can automate the login process so I don't have to continuously enter the username and password everytime I need to update it. I would also like it to automatically update every 2 minutes if able.

Below is the VBA in the Excel file. I'm still very new to VBA but am very eager to learn. Any help would be much appreciated.

Option Explicit

Sub OTIS()
Call CloseOTIS

' Application.Wait Now + TimeValue("00:00:02")

Call OpenOTIS

Call UpdateOTIS
End Sub

Sub CloseOTIS()
'---------------------------------------------------------------------------------------
' Terminates the exe process specified.
' Uses WMI (Windows Management Instrumentation) to query all running processes
' then terminates ALL instances of the exe process held in the variable strTerminateThis.
     '---------------------------------------------------------------------------------------

Dim strTerminateThis As String 'The variable to hold the process to terminate
Dim objWMIcimv2 As Object, objProcess As Object, objList As Object
Dim intError As Integer

'Process to terminate – you could specify and .exe program name here
strTerminateThis = "otis.exe"

'Connect to CIMV2 Namespace and then find the .exe process
Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
For Each objProcess In objList
intError = objProcess.Terminate 'Terminates a process and all of its threads.
'Return value is 0 for success. Any other number is an error.
If intError <> 0 Then Exit For
Next

'ALL instances of exe (strTerminateThis) have been terminated
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing

End Sub


Sub OpenOTIS()

Dim strPath As String

If Dir("C:\Program Files\OTIS", vbDirectory) <> "" Then

strPath = "C:\Program Files\OTIS\otis.exe"

    Shell strPath

    Application.Wait Now + TimeValue("00:00:03")

    AppActivate Application.Caption

    MsgBox "Enter OTIS Password, Then Press Enter." & vbCrLf & vbCrLf & "When OTIS Has Completed Opening, Press OK."


ElseIf Dir("C:\Program Files (x86)\OTIS", vbDirectory) <> "" Then

strPath = "C:\Program Files (x86)\OTIS\otis.exe"

    Shell strPath

    Application.Wait Now + TimeValue("00:00:03")

    AppActivate Application.Caption

    MsgBox "Enter OTIS Password, Then Press Enter." & vbCrLf & vbCrLf & "When OTIS Has Completed Opening, Press OK."

Else

    MsgBox "Path doesn't exist"

End If

End Sub

Sub UpdateOTIS()
'
' OTIS Macro
'
'Remember the ActiveSheet
' Set Ash = ActiveSheet
  


'    If MsgBox("Open OTIS.  If already open, close and reopen.  Press OK to continue....?", vbOKCancel, "Confirm") = vbOK Then

    'If MsgBox("The OTIS update will take 5-7 seconds.  Press OK to continue.", vbOKCancel, "Confirm") = vbOK Then

'       MsgBox "The OTIS update will take 5-7 seconds."

'Else

       'Exit Sub

    'End If

Application.Wait Now + TimeValue("00:00:02")
ActiveSheet.Select
Range("BA:GA").Select
Selection.ClearContents
Range("BA6").Select
ActiveSheet.Paste
Cells.Select
ActiveSheet.Sort.SortFields.Clear
' ActiveSheet.Sort.SortFields.Add Key:=Range("KR6:KR1000"), _
' SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' ActiveSheet.Sort.SortFields.Add Key:=Range("JP1:JP1000"), _
' SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("BA6:GA1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("A5").Select
    End With


Cells.Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Columns("BA:GA").Select
    Columns("BA:GA").EntireColumn.AutoFit


' Ash.Select
ActiveSheet.Select
Cells.Select
Selection.EntireRow.Hidden = False
Selection.RowHeight = 20
Range("A5").Select
Rows("1:1").AutoFit

End Sub

 

[Logit]

.
It appears from reviewing your macro that the need to enter a password and username is actually part of the external program OTIS.

Have you contacted that company to inquire if they already have information on an Excel Macro to perform the function you are requesting ?

 

[RedOctoberKnight]

Thanks for the info. It's a program that's on it's way out the door anyways. I just figured I'd try and make it a little more efficient while its still in use. Thanks for you help!

 

[RedOctoberKnight]

Was wondering if you saw anything in the code above that would cause the CloseOTIS sub to stop working? All of a sudden when I try and run the OTIS sub, it wont close OTIS anymore. If I have OTIS closed and run it, it will Open OTIS and do everything as normal but if I try and refresh it by running OTIS sub again, I just get a spinning wheel.

Thanks,

 

[Logit]

I do not see anything obvious. But of course I don't have your program to experiment with.

Review this :

Closing a Shell Window through VBA