I have a script which utilizes VBScript to identify the DNS for the machine it runs on. I have it alerting me if the DNS I'm looking for is being used. My hope is to take this one step further and if that specified DNS is found, to change that specific one to another DNS. I've found some scripts which seem the basic idea, but I do not think they will replace the identified one, just the one that is at the top of the list.
Here is my VBScript which identifies specified DNS:
'Bind to Shell
Set objShell = WScript.CreateObject("WScript.Shell")
'Read Servers NetbiosName
'strComputer = objShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\ComputerName")
strComputer = "."
wscript.echo strComputer
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colNicConfigs = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objNicConfig In colNicConfigs
If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
For Each strDNSServer In objNicConfig.DNSServerSearchOrder
if strDNSServer = "8.8.8.8" Then
wscript.echo "Works!"
End if
wscript.echo strDNSServer
Next
End If
Next
To clarify, the part I need help with is where the script prints out "works". I would like that DNS in particular to be changed to another specified DNS.
Here is some code I also found that claims to change DNS, but I am afraid if I insert it there it will simply place change the DNS at the top of the list, not the DNS I had identified:
Set objShell = WScript.CreateObject("Wscript.Shell")
objShell.Run "netsh interface ip set address name=""Local Area Connection"" static " & strIPAddress & " " & strSubnetMask & " " & strGateway & " " & intGatewayMetric, 0, True
Let me know if I can clarify anything! Thanks in advance!
You can set DNS servers using the SetDNSServerSearchOrder method (see here for an example). However, that method expects an array with all DNS servers you want to use, so you need to read the current DNS servers into an array, modify the address(es) you want to change, then call SetDNSServerSearchOrder with the modified array.
If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
dns = objNicConfig.DNSServerSearchOrder
For i = 0 To UBound(dns)
if dns(i) = "8.8.8.8" Then dns(i) = "4.4.4.4"
Next
objNicConfig.SetDNSServerSearchOrder(dns)
End If
Related
I have a problem, the macro below checks if there is a mail title from the sender. The problem is that in outlook, I have 2 accounts: IMAP and Exchange. Makro always chooses exchange. Where's the reason?
Sub srchmail()
Dim Itms As Items
Dim srchSender As String
Dim srchSubject As String
Dim strFilterBuild As String
Dim ItmsBuild As Items
Dim strFilter As String
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set sub_olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set sub_olFolder = sub_olFolder.Folders("SUBFOLDER")
Set Itms = sub_olFolder.Items
Dim i As Long
For i = 1 To Itms.Count
Next
srchSender = "SENDERMAIL"
srchSubject = "SUBJECTMAIL"
strFilter = "[SenderName] = '" & srchSender & "' And [Subject] = '" & srchSubject & "' And [SentOn] > '" & Format(Date, "dd-mm-yyyy") & "'"
Set Itms = Itms.Restrict(strFilter)
If Itms.Count = 0 Then
MsgBox "dont mail in " & sub_olFolder & " with sub:'" & srchSubject & "' on " & Format(Date, "dd-mm-yyyy")
Else
MsgBox "found mail in " & sub_olFolder & " with sub: '" & srchSubject & "' on " & Format(Date, "dd-mm-yyyy")
End If
ExitRoutine:
Set Itms = Nothing
End Sub
Your problem is:
Set sub_olFolder = objNS.GetDefaultFolder(olFolderInbox)
You can only have one default Inbox. Your default Inbox is clearly in the Exchange account. You will need to explicitly name the IMAP store to access its Inbox.
When you look at your folder pane, you will see something like this:
Xxxxxxxxxxx
Drafts
Deleted Items
Inbox
: :
Yyyyyyyyy
Drafts
Deleted Items
Inbox
SUBFOLDER
: :
Xxxxxxxxxxx and Yyyyyyyyy are the names of stores. Stores are the files in which Outlook saves all your emails, calendar items, tasks and so on. As I understand it, you MUST have one store per account. You can also have as many extra stores as you wish. I have stores named for my two accounts, “Archive”, “Test” and many more.
Try:
Set sub_olFolder = objNS.Folders("Yyyyyyyyy").Folders("Inbox")
Where “Yyyyyyyyy” is the name of the store (as it appears in the folder pane) containing the sub folder you wish to access.
I should perhaps add that I would have written:
Set Itms = Session.Folders("Yyyyyyyyy").Folders("Inbox").Folders("SUBFOLDER").Items
“Session” and “NameSpace” are supposed to be identical. I use Session because it avoids the need to create a namespace and because a long time ago I had a failure with NameSpace that I could not diagnose.
Unless you need to access the store or Inbox or SUBFOLDER in some other way, you do not need variables for them. Starting with the ultimate parent (Session) you can string the names of children, grandchildren and so on to any depth.
Be careful stringing properties together like this. (1) It can take a little time to get the string correct. (2) I have seen example of property strings where it is really difficult to determine what it being accessed. If you return to this macro in 12 months, will you remember what this string means? If someone else has to maintain your macro, will they understand what you have done? If in doubt, keep it simple.
Added because of error in original answer
It is not possible for me to test my answer. Try the following as a way for you to test my suggestion.
Replace "Yyyyyyyyy" in the following by the name of your IMAP store and then type it in your Immediate Window.
? Session.Folders("Yyyyyyyyy").Name
The interpreter should respond with the name of the IMAP store. If that works, try:
? Session.Folders("Yyyyyyyyy").Folders("Inbox").Name
The interpreter should respond Inbox. If that works, try:
? Session.Folders("Yyyyyyyyy").Folders("Inbox").Folders("SUBFOLDER").Name
The interpreter should respond SUBFOLDER. If that works, try:
? Session.Folders("Yyyyyyyyy").Folders("Inbox").Folders("SUBFOLDER").Items(1).ReceivedTime
The interpreter should respond with the date and time of the older email in the subfolder. If that works, my answer should work. If any of the above doesn't work, please respond with a detailed explanation of what failed
It looks like your Exchange account is set as default, so
when you get sub_olFolder, you are working with subfolder of Inbox of the message store that linked with Exchange account.
I was just upgraded to windows 10. This version of outlook I have enabled the macros in the trust center however it limits me on running vba from outlook. Also access is having issues when I run the task scheduler and run from a bat file the access database. An autoexec excutes and I tell the system to shut outlook down but it won't shut down the current instance of the outlook. Here Is the code I am using.
Public Function OutlookClose1()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
Set objOutlook = GetObject(Class:="Outlook.application")
objOutlook.Quit
Next
End Function
Public Function OutlookClose2()
Dim objAppOL As Outlook.Application
On Error Resume Next
Set objAppOL = GetObject(Class:="Outlook.application")
objAppOL.Quit
Set objAppOL = Nothing
Exit Function
End Function
I have tried outlookclose1 and 2 and neither work. DOes anyone have suggestions?
Also when running the outlookclose1 from the vba editor it does close. It takes the exchange offline, which I don't want. But from a bat file running the access database and having the autoexec run it it doesn't close down outlook.
Task scheduler runs as a service in a security context different from the currently logged in user even if the local user account is the same. COM system refuses to marshal calls between processes running in different security contexts.
I have office 2013 and windows 10. I could use the above code with Windows 7 and the task scheduler. I am on a domain with certain policies that I can't change and I don't have admin rights. At home not on a domain I can use that code too. With that being said I can at least terminate outlook from access and get the job done closing an outlook session so when the autoexec runs in the access database it closes outlook and then runs the reports and sends, Create Object Outlook.Application and it sends emails no problems. Here is how I terminate the code. The reason is I don't want multiple outlook sessions running.
Public Function OutlookClose1()
Dim objOutlook As Outlook.Application
delay = 30000 'delay in milliseconds to let Outlook close gracefully
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
objProcess.Terminate
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
Set colProcessList = Nothing
End Function
I'm still a bit shaky when dealing with WMI, but here's the scenario. My company has several models of HP laptops deployed across the domain, and we need to change the asset tag setting in the BIOS. This code works for all of our HP EliteBooks:
Set objWMIService = objSWbemLocator.ConnectServer( _
strComputer, "root\HP\InstrumentedBIOS")
'We have to search for the exact bios tag name because it varies by model
Set colItems = objWMIService.ExecQuery("SELECT * FROM HPBIOS_BIOSString", , 48)
For Each objItem In colItems
If InStr(1, objItem.Name, "Asset") Then strName = objItem.Name
Next
' Obtain an instance of the the class using a key property value.
Set objShare = objWMIService.Get( _
"HPBIOS_BIOSSettingInterface.InstanceName='ACPI\PNP0C14\0_0'")
' Obtain an InParameters object specific to the method.
Set objInParam = objShare.Methods("SetBIOSSetting").InParameters.SpawnInstance_()
' Add the input parameters.
objInParam.Properties_.item("Name") = strName
objInParam.Properties_.item("Value") = strAssetTag
objInParam.Properties_.item("Password") = "<utf-16/>" & strPassword
' Execute the method and obtain the return status.
' The OutParameters object in objOutParams is created by the provider.
Set objOutParams = objWMIService.ExecMethod( _
"HPBIOS_BIOSSettingInterface.InstanceName='ACPI\PNP0C14\0_0'", _
"SetBIOSSetting", objInParam)
Select Case objOutParams.return
Case 0
strReturn = "Success. Asset Tag " & strAssetTag & _
" will be configured the next time you reboot " & _
strComputer & "."
Case 1
strReturn = "1: Not Supported"
Case 2
strReturn = "2: Unspecified Error"
Case 3
strReturn = "3: Timeout"
Case 4
strReturn = "4: Failed"
Case 5
strReturn = "5: Invalid Parameter"
Case 6
strReturn = "6: Access Denied"
Case Else
strReturn = "..."
End Select
The problem is that on HP ZBooks, the InstaneName is ACPI\PNP0C14\1_0. So changing the line to the correct instance makes it work for the ZBooks but breaks it for the EliteBooks. Eg:
Set objShare = objWMIService.Get( _
"HPBIOS_BIOSSettingInterface.InstanceName='ACPI\PNP0C14\1_0'")
I could create two scripts, one for the EliteBooks and one for the ZBooks, but since there is always only one Active instance, I would rather create one script that gets that active instance. For example (non-working code that I wished worked):
Set objShare = objWMIService.Get( _
"HPBIOS_BIOSSettingInterface.Active='True'")
So, how can I find the InstanceName of the Active HPBIOS_BIOSSettingInterface?
So maybe this was too simple or maybe there's a better way to do this, but here's how I ended up solving it:
I simply reused the colItems object to get a collection of Instances. There should only be one, but I verify that I have the correct instance by checking it's .Active property.
'We have to search for the exact bios tag name because it varies by model
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM HPBIOS_BIOSString", , 48)
For Each objItem In colItems
If InStr(1, objItem.Name, "Asset") Then strTagName = objItem.Name
Next
'We have to search for the exact instance name because it varies by model
Set colItems = objWMIService.ExecQuery( _
"SELECT * FROM HPBIOS_BIOSSettingInterface", , 48)
For Each objItem In colItems
If objItem.Active = "True" Then
strInstanceName = objItem.InstanceName
End If
Next
' Obtain the active instance.
Set objShare = objWMIService.Get( _
"HPBIOS_BIOSSettingInterface.InstanceName='" & strInstanceName & "'")
Not sure if this is the cleanest method for doing this, but it works.
I spend hours finding the problem.
I want to start the SAP Logonpad with the ini file, that works fine.
Then after binding to the scripting object I want to open the connection to a specific System with connection = SapGui.OpenConnection("SID", True)
but always get runtime error 70 access denied.
I followed what others seem to do with vbs, for certain resons I can't do it with vbs and have to go with vba, so maybe there might be some difference that makes it fail?
Any advice would be highly appreciated.
Private Sub CommandButton1_Click()
Dim SapGui As Object
Dim saplogon As Object
Dim connection 'As Object
Set SapGui = GetObject("SAPGUI")
Dim Wshshell As Object
Set Wshshell = CreateObject("Wscript.Shell")
Wshshell.Run Chr(34) & ("C:\Program Files\SAPPC\FrontEnd\SAPgui
\saplogon.exe") & Chr(34) & " " & "/INI_FILE" & "=" & Chr(34) &
"\\longpathtoini\appl\Sap\saplogon\int\saplogon.ini" & Chr(34)
Do Until Wshshell.AppActivate("SAP Logon")
Application.Wait Now + TimeValue("0:00:01")
Loop
Set Wshell = Nothing
Set saplogon = SapGui.GetScriptingEngine
connection = SapGui.OpenConnection("SID", True)
Set SapGui = Nothing
Set saplogon = Nothing
Set connection = Nothing
End Sub
Check whether user scripting is allowed for the particular system (transaction RZ11, parameter sapgui/user_scripting). Also be aware that for some versions, you'll apparently need to specify the SAP Logon entry text instead of the SID.
Thanks to vwegert.
I surely knew about scripting needs to be enabled on the servers.
Which is, but at the moment I read his answer I remembered that in my SAP GUI settings the checkbox for "Warn if a script tries to connect" was enabled.
Disabeling that options did lead to success.
The above code works perfectly.
I have logged into my workstation with my normal domain credentials. We shall call this AccountA.
I then use the "run as a different user" to launch Excel. We shall call this AccountB. I do this because the permissions needed to query some SQL servers must be done using AccountB.
At this point, I need to include a subroutine to launch a Shell to create directories and move files on a remote server. AccountB doesn't have (and cannot have) permissions to do this. My shell gives me an Access Denied message. Fine.
So now, I need to have VBA return the name of AccountA, the account I have used to log into the computer. How do I do this?
I have seen quite a few examples on this site as well as others that will return the username running Excel (AccountB). However, I have not seen any examples that will pull AccountA information to pass to the Shell via RunAs to carry out my commands with the proper permissions. Below are some things I have tried, all returning AccountB (the account used via RunAs to launch Excel)
This application will be used by multiple people with permissions to run cmd shell on the remote server, so AccountA cannot be hardcoded and must be programmatically obtained.
' Access the GetUserNameA function in advapi32.dll and
' call the function GetUserName.
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Sub XXXXXXXXXX()
'//
ThisWorkbook.Sheets("XXXXXXXXXX").Activate ' select the worksheet for use
cmdString = UCase(Trim(ThisWorkbook.ActiveSheet.Cells(4, 4).Value)) 'get XXXXXXXXXX
'MsgBox cmdString
'retval = Shell("cmd.exe /k " & cmdString, vbNormalNoFocus)
'cmdString = "MkDir \\XXXXXXXXXX\g$\Tempski" 'fails - no permission
'Set the Domain
txtdomain = "XXXXXXXXXX"
'Acquire the currently logged on user account
'txtuser = "XXXXXXXXXX"
' Dimension variables
Dim lpBuff As String * 255
Dim ret As Long
' Get the user name minus any trailing spaces found in the name.
ret = GetUserName(lpBuff, 255)
If ret > 0 Then
GetLogonName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
Else
GetLogonName = vbNullString
End If
MsgBox GetLogonName
Dim objNet As Object
On Error Resume Next
Set objNet = CreateObject("WScript.NetWork")
MsgBox "Network username is: " & objNet.UserName
Set objNet = Nothing
MsgBox "Environ username is: " & Environ("USERNAME")
MsgBox "Application username is: " & Application.UserName
MsgBox "Network username is: " & WindowsUserName
Dim strUser As String
strUser = ActiveDirectory.user()
MsgBox "Welcome back, " & strUser
CurrentWorkbenchUser = Environ("USERDOMAIN") & "\" & Environ("USERNAME")
MsgBox CurrentWorkbenchUser
Set WSHnet = CreateObject("WScript.Network")
UserName = WSHnet.UserName
UserDomain = WSHnet.UserDomain
Set objUser = GetObject("WinNT://" & UserDomain & "/" & UserName & ",user")
GetUserFullName = objUser.FullName
MsgBox GetFullUserName
'//try to pass user credentials to shell - service account cannot run XXXXXXXXXX
'//This Works when txtdomain and txtuser are passed properly (MUST GRAB THESE SOMEHOW)
'retval = Shell("runas /user:" & txtdomain & "\" & txtuser & " ""cmd.exe /k dir /s *.*""", vbNormalFocus)
End Sub
All the bits of code above return the account used to launch Excel — not what I need i.e. the account I used to log into the computer.
The basic approach is to execute the shell with a "run as" parameter.
have you taken a look at this
also look here
This is code ripped from the ms sight and is just here to make sure that the next guy or gal who comes by has a quick reference.
Sub RegisterFile(ByVal sFileName As String)
ShellExecute 0, "runas", "cmd", "/c regsvr32 /s " & """" & sFileName & """", "C:\", 0 'SW_HIDE =0
End Sub
As an aside if you only need the account for access to a SQL server, you should be able to just set the account within the connection string in your vba MACRO. I've done that for an Oracle DB in the past.