Due to Updates to Windows 10 Enterprise our MS Access VBA script isn't working anymore. Everything was fine using Windwows 8.1.
Private Sub click_Click()
Dim shell As Object
Set shell = VBA.CreateObject("WScript.Shell")
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim Style As Integer: Style = 2
Dim errorCode As Long
temp = "cmd.exe /k cd.."
errorCode = shell.Run(temp, Style, waitTillComplete)
End Sub
The error occurs executing the .Run and returns
"Run-time error '70': Permission denied".
Any ideas to fix or work around the problem?
Related
I am trying to connect to HPQC though vbscript in excel. I have already added the OTA library to Reference.
When I am trying to instantiate an object as TDConnection,
Global tdc As TDConnection
Set tdc = new TDConnection
its throwing an error:
Run-time error '429':
ActiveX component can't create object.
I used the below code to check:
Sub Connect()
Dim tdc as TDConnection
Dim url as String
Dim Domain as String
Dim Project as String
Dim username as String
Dim Password as String
url = "http://qc.abcdef.com"
Domain = "NNNN"
Project = "NNNNNNN"
username = "ABCD"
Pasword = "XYZ"
Disconnect 'Disconnects any open connections
If (tdc Is Nothing) Then Set tdc = New TDConnection
If (tdc Is Nothing) Then GoTo ConnectionErr
tdc.InitConnectionEx url 'Initiate Connection
tdc.Login username, Password
tdc.Connect Domain, Project
MsgBox "Connection Established"
Exit Sub
ConnectionErr:
MsgBox "Connection Error"
End Sub
Then ran from cmd the below command
C:\Windows\SysWOW64> wscript.exe "C:\...\QC.vbs"
but facing error
Please help!
Try running your VB script with command prompt using specific cscript -
C:\WINDOWS\SysWOW64>cscript.exe ".... .vbs"
For more info refer https://community.hpe.com/t5/Quality-Center-ALM-Practitioners/ActiveX-component-can-t-create-object-TDApiOle80-TDConnection/td-p/4742677
I have been searching around on the internet and am having problems finding a solution to this issue.
Basically I am trying to execute a registry query with administrator privileges using Shell.Application from within VBA to read the value of TypeGuessRows (and eventually modify it to 0 aswell so that excel data can be correctly queried using ADOdb). I have come up with the following sub routine:
Sub Read_Registry_Value()
'Declare variables
Dim reg_key_location As String
Dim reg_key_name As String
Dim wsh As Object
'Define registry key path and name
reg_key_location = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\15.0\Access Connectivity Engine\Engines\Excel"
reg_key_name = "TypeGuessRows"
'Create instance of windows shell
Set wsh = VBA.CreateObject("Shell.Application")
'Execute registry query with administrative privileges
wsh.ShellExecute "cmd", _
"/K REG QUERY " & Chr(34) & reg_key_location & Chr(34) & " /v " & reg_key_name, _
"", _
"runas", _
1
End Sub
All that is returned from this routine is:
ERROR:
The system was unable to find the specified registry key or value.
However the registry key most definitely exists. Refer to screenshot below. Additionally the command prompt should also be running with admin rights according to my code above.
Registry Key Screenshot:
Furthermore executing the command...
REG QUERY "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\15.0\Access Connectivity Engine\Engines\Excel" /v TypeGuessRows
Directly in command prompt works without any Administrator Rights.
REG EDIT Manually in CMD:
So I'm lost on how to get this function working correctly and any help on this issue would be much appreciated!
**** UPDATE ****
Ok so i've implemented the code suggested by Dinotom in the first answer. See extract of code below.
Sub Read_Registry()
Dim entryArray() As Variant
Dim valueArray() As Variant
Dim reg_key_location As String
Dim x As Integer
reg_key_location = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\15.0\Access Connectivity Engine\Engines\Excel"
Call EnumerateRegEntries(reg_key_location, entryArray, valueArray)
For x = 0 To UBound(entryArray)
'Do something here
Next x
End Sub
Public Sub EnumerateRegEntries(keyPath As String, arrEntryNames As Variant, arrValueTypes As Variant)
Dim registryObject As Object
Dim rootDirectory As String
rootDirectory = "."
Set registryObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
rootDirectory & "\root\default:StdRegProv")
registryObject.EnumValues HKEY_LOCAL_MACHINE, keyPath, arrEntryNames, arrValueTypes
End Sub
However the following error is returned on the For x = 0 ... line...
ERROR:
Run-time error '9' Subscript out of range.
It doesn't look like the arrays are being populated with the registry data as suggested below. Any more ideas?
Do you have to use Shell?
This will enumerate your registry entries, manipulate as you need.
Set up empty arrays to pass as the parameters, and the keypath is the local file path to your registry to enumerate. the sub will fill the arrays.
Dim entryArray() As Variant, valueArray() As Variant
Call EnumerateRegEntries("pathtokey",entryArray, valueArray)
The sub below will run and entryArray and valueArray will be populated.
Then you can iterate over the arrays
For x = 0 to UBound(yourarrayhere)
'Do something here
Next x
Enumerate method:
Public Sub EnumerateRegEntries(keyPath As String, arrEntryNames As Variant, arrValueTypes As Variant)
Dim registryObject As Object
Dim rootDirectory As String
rootDirectory = "."
Set registryObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
rootDirectory & "\root\default:StdRegProv")
registryObject.EnumValues HKEY_LOCAL_MACHINE, keyPath, arrEntryNames, arrValueTypes
End Sub
if you are unable to alter or use this sub, then look here
Chip Pearsons registry page
or, if you have some requirement to use Shell, then look here for how to run as Admin
run shell as admin
The path is wrong.
Set the path like this:
reg_key_location = "SOFTWARE\Microsoft\Office\15.0\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\15.0\Access Connectivity Engine\Engines\Excel"
The HKEY_LOCAL_MACHINE is placed when calling the object:
registryObject.EnumValues HKEY_LOCAL_MACHINE, keyPath, arrEntryNames, arrValueTypes
EDIT: Also remind that if you are running windows 64 bits and office 32 bits, the stdregprov only reads inside Wow6432Node.
This is my first question so please go easy on me.
My company is working with Reflection for UNIX and OpenVMS and I'm building a database that interacts with the software as it is impossible for me to access the database behind the Reflection application (too many authorizations required etc...).
I'm working with MS Access 2013 right now and coding in VBA. My main issue is closing the Reflection instance in a clean manner.
The following code works fine for me :
Sub Test()
Dim strUserId As String
Dim MyObject As Reflection2.Session
Set MyObject = GetObject(Path)
strUserId = InputBox("Enter user ID.")
ContractNum = InputBox("Enter a contract number :")
With MyObject
.Visible = True
.Connect
.Transmit strUserId
.TransmitTerminalKey rcVtEnterKey
.Transmit ContractNum
.TransmitTerminalKey rcVtEnterKey
sContractNum = .GetText(1, 18, 1, 28)
'Do other shit
End With
**Exit Reflection**
Set MyObject = Nothing
End Sub
I have tried the following methods :
MyObject.Close ==> Returns : "Run-time error '438': Object doesn't support this property of method"
MyObject.Exit ==> Returns : "Run-time error '438': Object doesn't support this property of method"
MyObject.Quit ==> Returns : "Run-time error '10097': This function not available when running Reflection as a document object."
There is: MyObject.ConfirmExit = True but as it says, it only confirms and doesn't close.
Anyway I was hoping someone would help before doing a hard closing through Shell command (wouldn't be difficult to find on Google I guess).
Thank you!!
Found a way using the following code, it is quite a harsh closing but works fine for the moment :
Function TaskKill(sTaskName)
TaskKill = CreateObject("WScript.Shell").Run("taskkill /f /im " & sTaskName, 0, True)
End Function
If TaskKill("r2win.exe") = 0 Then MsgBox "Terminated" Else MsgBox "Failed"
Hope that helps
I keep getting an error:
System.NullReferenceException: Object reference not set to an instance
of an object.
Everytime I run the application outside the IDE, but for some magical reason, it works fine inside the IDE. I am definitely sure the error is caused by this code as the app ran smoothly when I removed it:
Public Function GetCommonFolder() As String
On Error GoTo ErrH
Dim winPath As String = Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData)
Dim commonfolderpath As String
commonfolderpath = Replace(winPath & "\MyApp Data", "\\", "\")
If My.Computer.FileSystem.DirectoryExists(commonfolderpath) = False Then
System.IO.Directory.CreateDirectory(commonfolderpath)
End If
GetCommonFolder = commonfolderpath
Exit Function
ErrH:
GetCommonFolder = ""
Msgbox("Error retrieving common folder")
End Function
Does anyone here know what is causing this annoying problem?
It seems like the user that you run the program on outside the IDE doesn't have access to the common application data folder. Try executing it by "Run as administrator". Are you running on Windows Vista or newer? Maybe you have to require UAC elevation?
So I'm going round in circles trying to get this to work, I've been trying for two days and I just can't figure it out.
I have the following vb function that takes a created powershell script, and should run it in powershell. Everything works fine, until the point at which the command pipeline is invoked. At this point, no commands run.
As you can see, I have tried to add the Microsoft.Exchange.Management.PowerShell.E2010 snapin to the runspace, it didn't like that at all stating something along the lines of the snapin didnt exist (which it does), and also when I run the code as shown, no commands are recognised as valid. I even added the specific command "Add-PSSnapin" to try and load any Exchange snapins, but it states that "Add-PSSnapin" is not recognised as a valid command.
If I pause the program just before the commands are involked, I can see every command within the pipeline, in the correct format. If I copy and paste the command text in the pipeline directly into a powershell window, it runs fine.
My code is below, any suggestions welcome.
edit: I have also tried adding the line "Add-PSSnapin Ex" (with an asterisk each side of Ex - I cant figure the formatting out on this, sorry)
to try and load the Exchange PS Snapins as the first thing the script would run (opposed to setting this up in the runspace) but no luck
Private Function scriptRunner(ByVal scripttorun As String) As String
Dim initial As InitialSessionState = InitialSessionState.CreateDefault()
Dim result As String = ""
Dim lineFromScript As String = ""
Dim reader As New StreamReader(tempScript)
Dim rsConfig As RunspaceConfiguration = RunspaceConfiguration.Create()
Dim snapInException As New PSSnapInException
Dim strUserName As String = "DOMAIN\USER"
Dim strPassword As String = "PASSWORD"
Dim SecuredPSWD As New System.Security.SecureString()
For Each character As Char In strPassword
SecuredPSWD.AppendChar(character)
Next
Dim wsmConnectionInfo As WSManConnectionInfo
Dim strSystemURI As String = "http://SERVER.DOMAIN/powershell?serializationLevel=Full"
Dim strShellURI As String = "http://schemas.microsoft.com/powershell/Microsoft.Exchange"
Dim powerShellCredentials As PSCredential = New PSCredential(strUserName, SecuredPSWD)
wsmConnectionInfo = New WSManConnectionInfo(New Uri(strSystemURI), strShellURI, powerShellCredentials)
Dim runspace As Runspace = RunspaceFactory.CreateRunspace(wsmConnectionInfo)
Runspace.Open()
' runspace.RunspaceConfiguration.AddPSSnapIn("Microsoft.Exchange.Management.PowerShell.E2010", snapInException)
Dim pipeLine As Pipeline = runspace.CreatePipeline()
Dim command As Command = New Command("")
' TEST >> pipeLine.Commands.Add("Add-PSSnapin *Ex*")
Do While reader.Peek() <> -1
lineFromScript = Nothing
lineFromScript = reader.ReadLine()
pipeLine.Commands.Add(lineFromScript)
'command.Parameters.Add(lineFromScript)
'pipeLine.Commands.Add(command)
Loop
'' Run the contents of the pipeline
Dim psObjCollection As Collection(Of PSObject) = pipeLine.Invoke()
runspace.Close()
runspace.Dispose()
Return ""
End Function
I ended up working around the problem rather than fixing it.
I moved the script code into the vb.net application, and wrote each line to a file, i.e.
writer.WriteLine("Add-PSSnapin *Ex*")
Then I loaded the script through PowerShell as an application;
Dim exeStartInfo As System.Diagnostics.ProcessStartInfo
Dim exeStart As New System.Diagnostics.Process
exeStartInfo = New System.Diagnostics.ProcessStartInfo("C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe")
exeStartInfo.Arguments = ("-command work\scriptbuilder.ps1")
exeStartInfo.WorkingDirectory = "C:\ExchangeManager\"
exeStartInfo.UseShellExecute = False
exeStart.StartInfo = exeStartInfo
exeStart.Start()
exeStart.Close()
Not ideal but it got the job done.