I need to get installed software in as shows in Uninstall Program in control panel. So i used Win32_RegistryAction class for querying in vb script. But still i could not query a particular key and it hangs. Here is the piece of code which i used. Please help me how to get installed software details using wmi query.
Thanks in advance
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_RegistryAction where key ='SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\' and Root=2 ")
For Each objComputer in colSettings
Wscript.Echo "Display Name: " & objComputer.DisplayName
Next
You are using the wrong WMI class, you must use the StdRegProv class instead, for examples about how use this try the MSDN documentation (WMI Tasks: Registry).
Here i am answering to my own question. Thank You RRUZ for lead me in a right way. Here i have solution for this problem. Now i am able to get all installed software which are showing the uninstall program in windows. Sample code is giving here
Dim count
Const HKEY_LOCAL_MACHINE = &H80000002
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames
count = 0
For i=0 To UBound(arrValueNames)
StrText = arrValueNames(i)
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "DisplayName",strName
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "DisplayVersion",strVersion
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "InstallLocation",strLocation
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "InstallDate",strDate
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "SystemComponent",strSystemComponent
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "WindowsInstaller",strWindowsInstaller
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "UninstallString",strUninstallString
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "ReleaseType",strReleaseType
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "ParentKeyName",strParentKeyName
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "Publisher",strPublisher
if isNull(strSystemComponent) then
if isNull(strWindowsInstaller) then
if not isNull(strUninstallString) then
if isNull(strReleaseType) then
if isNull(strParentKeyName) then
if not isNull(strName) then
printKeyValue "Win32_Product.PackageName[" & count & "]", StrName
printKeyValue "Win32_Product.Version[" & count & "]", StrVersion
printKeyValue "Win32_Product.InstallLocation[" & count & "]", strLocation
printKeyValue "Win32_Product.InstallDate[" & count & "]", strDate
printKeyValue "Win32_Product.Publisher[" & count & "]", strPublisher
printKeyValue "Win32_Product.WindowsInstaller[" & count & "]", strWindowsInstaller
printKeyValue "Win32_Product.UninstallString[" & count & "]", strUninstallString
printKeyValue "Win32_Product.ReleaseType[" & count & "]", strReleaseType
printKeyValue "Win32_Product.ParentKeyName[" & count & "]", strParentKeyName
count = count + 1
end if
end if
end if
end if
end if
end if
Next
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames
For i=0 To UBound(arrValueNames)
StrText = arrValueNames(i)
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "DisplayName",strName
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "DisplayVersion",strVersion
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "InstallLocation",strLocation
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "InstallDate",strDate
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "SystemComponent",strSystemComponent
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "WindowsInstaller",strWindowsInstaller
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "UninstallString",strUninstallString
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "ReleaseType",strReleaseType
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "ParentKeyName",strParentKeyName
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & "\" & arrValueNames(i), "Publisher",strPublisher
if isNull(strSystemComponent) then
if isNull(strWindowsInstaller) then
if not isNull(strUninstallString) then
if isNull(strReleaseType) then
if isNull(strParentKeyName) then
if not isNull(strName) then
printKeyValue "Win32_Product.PackageName[" & count & "]", StrName
printKeyValue "Win32_Product.Version[" & count & "]", StrVersion
printKeyValue "Win32_Product.InstallLocation[" & count & "]", strLocation
printKeyValue "Win32_Product.InstallDate[" & count & "]", strDate
printKeyValue "Win32_Product.Publisher[" & count & "]", strPublisher
printKeyValue "Win32_Product.WindowsInstaller[" & count & "]", strWindowsInstaller
printKeyValue "Win32_Product.UninstallString[" & count & "]", strUninstallString
printKeyValue "Win32_Product.ReleaseType[" & count & "]", strReleaseType
printKeyValue "Win32_Product.ParentKeyName[" & count & "]", strParentKeyName
count = count + 1
end if
end if
end if
end if
end if
end if
Next
Function printKeyValue(key, value)
Wscript.Echo key & "=>" & value
End Function
Here the path Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall is only applicable for Windows 7 or above.
Related
How do I save email (msg)?
This code creates a daily folder structure and saves email attachments but not the email itself.
Option Explicit
Public Sub saveAttachtoDisk(itm As Outlook.mailitem)
Dim objAtt As Outlook.Attachment
Dim SaveFolder As String
SaveFolder = "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)
' Check for folder and create if needed
If Len(Dir("C:\Temp\" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:\Temp\" & Year(Date)
End If
If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date), _
vbDirectory)) = 0 Then
MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date)
End If
If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date), _
vbDirectory)) = 0 Then
MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)
End If
For Each objAtt In itm.Attachments
objAtt.SaveAsFile SaveFolder & "\" & Format(Date, "yyyymmdd") & "_" & _
objAtt.DisplayName
Next
Set objAtt = Nothing
End Sub
Try
Dim FileName As String
FileName = Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName
itm.SaveAs SaveFolder & "\" & FileName & ".msg", olMsg
Also Replace invalid characters with empty strings, here I'm using Regex
For Each objAtt In itm.Attachments
Dim FileName As String
FileName = Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName
objAtt.SaveAsFile SaveFolder & "\" & FileName
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.Pattern = "[^\w\#-]"
.IgnoreCase = True
.Global = True
End With
FileName = RegEx.Replace(FileName, " ")
itm.SaveAs SaveFolder & "\" & FileName & ".msg", olMsg
Next
Now test your code with Selection.item(1)
Public Sub Test_Rule()
Dim olMsg As Outlook.mailitem
Set olMsg = ActiveExplorer.Selection.Item(1)
saveAttachtoDisk olMsg
End Sub
Call itm.SaveAs(..., olMsg) to save in the MSG format
I have learned Crystal by trial and error, so please forgive my phrasing.
I want to combine text and fields. If there is more than one instance of Tensile.SOItemNum, then I want to repeat all instances of that field within my resultant text string and have the multiple instances be separated by commas. (Actually I would want this section to repeat for each record of Tensile.SOITEM.
The following is the formula for one text string and this would work if there were just one record.
Formula = "0003015339|01|" & totext({Tensile.SONum},0,"") & "-" &
totext({Tensile.SOItemNum},0,"") & "-" & {Tensile.Lot} & "|" & {SOItem.CustPO} &
"|" & totext({SOItem.SOItemNum},0,"") & "|" & {SOItem.ProdCode} & "|" &
totext({ManifestLotView.Manifest},0,"") & "-" &
totext({ManifestLotView.SONum},0,"") & "-" &
totext({ManifestLotView.SOItemNum},0,"")
Which produces:
0003015339|01|114667-10-1-B-1|5400361554-R01|10|XALRET05012|27202-114667-10
If there were a 114667-10-1-B-1 and a 114668-5-2-B-1, I would want the string resultant string to read:
0003015339|01|114667-10-1-B-1,114668-5-2-B-1|5400361554-
R01|10|XALRET05012|27202-114667-10
This is some of what I was trying, but it is not a valid formula. I have not used the Next function before.
Formula = "0003015339|01|" & totext({Tensile.SONum},0,"") & "-" &
totext({Tensile.SOItemNum},0,"") & "-" & {Tensile.Lot} & IF nextvalue
({Tensile.SONum}) > 1 then "," & totext({Tensile.SONum},0,"") & "-" &
totext({Tensile.SOItemNum},0,"") & "-" & {Tensile.Lot} end if "|" &
{SOItem.CustPO} & "|" & totext({SOItem.SOItemNum},0,"") & "|" &
{SOItem.ProdCode} & "|" & totext({ManifestLotView.Manifest},0,"") & "-" &
totext({ManifestLotView.SONum},0,"") & "-" &
totext({ManifestLotView.SOItemNum},0,"")
Thank you in advance for your time.
I need to find files in a folder, and I have 3 cases on files naming:
DI0425522.pdf
AL-DN-DI0425523.pdf
AL-DN-DI0425524-2016-11-17_1108.pdf
I can handle the first and the second case, but I need to find the third too. the last 16 characters of the 3. filename can variate, so I think to use RegExp to match it, then copy all files in another folder.
the string is stored in an excel cell, but only with "DI#######" naming
DI0425522 (A2 cell)
DI0425523 (A3 cell)
DI0425524 (A4 cell)
This is the code, but it doesn't work: it shows error 438 "object doesn't support this property or method" on the If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf") <> "" Then line
Sub cerca()
Dim T As Variant
Dim D As Variant
T = VBA.Format(VBA.Time, "hh.mm.ss")
D = VBA.Format(VBA.Date, "yyyy.MM.dd")
Dim Ricercatore As Variant
Ricercatore = Cells(1, 3)
Dim Source As String
Dim Dest As String
Source = "\\it-s-bolo02\WORKGROUP\Comune\000_0_______ COMUNE 2011\15_TECNICO\AAA - RICERCA DDT\ALSS\DDT"
Dest = "\\it-s-bolo02\WORKGROUP\Comune\000_0_______ COMUNE 2011\15_TECNICO\AAA - RICERCA DDT\ALSS\Ricerca\Ricerca " & D & " " & T & " " & Ricercatore
MkDir Dest
Dim ValoreCella As Variant, r As Long, DDTmancanti As Variant
r = 2
Do Until Cells(r, 1) = ""
ValoreCella = Cells(r, 1)
If Dir(Source & "\DI\" & ValoreCella & ".Pdf") <> "" Then
FileCopy Source & "\DI\" & ValoreCella & ".Pdf", Dest & "\" & ValoreCella & ".Pdf"
Else
If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & ".Pdf") <> "" Then
FileCopy Source & "\DI\" & "AL-DN-" & ValoreCella & ".Pdf", Dest & "\" & "AL-DN-" & ValoreCella & ".Pdf"
Else
Dim regex As Object, str As String
Set regex = CreateObject("VBScript.RegExp")
str = "-([0-9]*)-([0-9]*)-([0-9]*)_([0-9]*)"
With regex
.Pattern = str
.Global = True
End With
If Dir(Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf") <> "" Then
FileCopy Source & "\DI\" & "AL-DN-" & ValoreCella & regex & ".Pdf", Dest & "\" & "AL-DN-" & ValoreCella & regex & ".Pdf"
Else
If Dir(Source & "\Altro\" & ValoreCella & ".Pdf") <> "" Then
FileCopy Source & "\Altro\" & ValoreCella & ".Pdf", Dest & "\" & ValoreCella & ".Pdf"
Else
DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
End If
End If
End If
End If
r = r + 1
Loop
Dim FF As Long
FF = FreeFile
Open (Dest & "\" & "0 - DDT_mancanti.txt") For Output As #FF
Write #FF, DDTmancanti
Close #FF
MsgBox "Operazione eseguita"
Shell "explorer.exe " + Dest, vbNormalFocus
End Sub
Thanks for help
A RegExp is an object and it doesn't have a default property, so you can't just concatenate it into a string and use it like a wildcard. If you need to find a matching file with Dir, you need to loop over the directory and test each resulting filename with the regular expression until you find a match. You can cut down on some of the extraneous matches by using wildcards in the Pathname argument for Dir - for example, Source & "\DI\*DI???????*.pdf" should eliminate most of them.
Also, because you can't use a "partial" regular expression with Dir, you'll need to build a regular expression that will match any of your file specs completely. This should work based on your example file names:
^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$
This simplifies your main loop quite a bit. Add a flag for whether or not a match was found, and exit early when you find a match. Something like this should be closer to what you need (untested):
'...
r = 2
With New RegExp
.Pattern = "^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$"
Do Until Cells(r, 1) = ""
Dim found As Boolean
ValoreCella = Cells(r, 1)
Dim current As String
current = Dir$(Source & "\DI\*DI???????*.pdf")
Do Until current = vbNullString
If .Test(current) Then 'Found the file.
FileCopy current, Dest & "\" & current
found = True
Exit Do
End If
current = Dir$()
Loop
If Not found Then DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
found = False
r = r + 1
Loop
End With
Dim FF As Long
'...
I tried but doesn't work. Here your code with comments:
With New RegExp
.Pattern = "^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$"
Do Until Cells(r, 1) = ""
Dim found As Boolean
ValoreCella = Cells(r, 1)
Dim current As String
current = Dir$(Source & "\DI\*DI???????*.pdf")
Do Until current = vbNullString
If .Test(current) Then 'Found the file.
FileCopy current, Dest & "\" & current 'Error 53 File not found--> current var is the first file found without Source string, see image attached
found = True
Exit Do
End If
current = Dir$()
Loop
If Not found Then DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
found = False
r = r + 1
Loop
End With
Dim FF As Long
I Tried this mod:
With New RegExp
.Pattern = "^(AL-DN-)?DI\d{7}(-\d{4}-\d{2}-\d{2}_\d{4})?\.pdf$"
Do Until Cells(r, 1) = ""
Dim found As Boolean
ValoreCella = Cells(r, 1)
Dim current As String
current = Dir$(Source & "\DI\*DI???????*.pdf")
Do Until current = vbNullString
If .Test(current) Then 'Found the file.
Dim SourceDI, DestDI As String
SourceDI = Source & "\DI\" & current
DestDI = Dest & "\" & current
FileCopy SourceDI, DestDI
found = True
Exit Do
End If
current = Dir$()
Loop
If Not found Then DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
found = False
r = r + 1
Loop
End With
The file string is now correct, but there's not a test with ValoreCella value, so the code will return the first file found in folder, then stops
UPDATE:
I solve the problem without RegExp in this way:
'...
Do Until Cells(r, 1) = ""
ValoreCella = Cells(r, 1)
Dim current As String
current = Dir$(Source & "\DI\*" & ValoreCella & "*.pdf")
If current <> "" Then
FileCopy Source & "\DI\" & current, Dest & "\" & current
Else
DDTmancanti = DDTmancanti & ValoreCella & vbCrLf
End If
r = r + 1
Loop
'...
Thanks for your help
I have developed a .vbs to call a SOAP web services as below. During execution, I get the error code 500. Please share your ideas if you faced this before.
I use Windows 7 to execute this file.
Dim dt
mydt = Now()
mm = add0( Month(mydt))
dd = add0( Day(mydt))
hh = add0( Hour(mydt))
mn = add0( Minute(mydt))
ss = add0( second(mydt))
'WScript.Echo (Year(mydt)) & mm & dd & hh & mm & ss
'short-name: Max 8 char
dt = mm & dd & hh & mm
Function add0 (testIn)
Select Case Len(testIn) < 2
Case True
add0 = "0" & testIn
Case Else
add0 = testIn
End Select
End Function
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\test"
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile In colFiles
strFileName = objFile.Name
If objFSO.GetExtensionName(strFileName) = "xml" Then
strUrl = "http://IP:Server/dummy"
strRequest = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/""" &_
" xmlns:v1=""http://crsoftwareinc.com/xml/ns/titanium/newbiz/newbusinessuploadreleaseservice/v1_0""" &_
" xmlns:v11=""http://www.crsoftwareinc.com/xml/ns/titanium/common/v1_0""" &_
" <soapenv:Header>/" &_
" <soapenv:Body>" &_
" <v1:new-business-upload-release-request>" &_
" <v1:new-business-upload-dto>" &_
" <v11:ID>ID="& dt &"</v11:ID>" &_
" <v11:file-name>"& objFile.Name &"</v11:file-name>" &_
" <v11:manual-upload>""false</v11:manual-upload>" &_
" <v11:auto-linking-enabled-flag>""true</v11:auto-linking-enabled-flag>" &_
" <v11:auto-merging-enabled-flag>""true</v11:auto-merging-enabled-flag>" &_
" <v11:strategy-option-choice>""USE_CREDITOR_DEFAULT_STRATEGY</v11:strategy-option-choice>" &_
" <v11:account-strategy-option-choice>""USE_CREDITOR_DEFAULT_STRATEGY</v11:account-strategy-option-choice>" &_
" <v11:auto-release>""true</v11:auto-release>" &_
" </v1:new-business-upload-dto>" &_
" <v1:web-service-request-version>""2</v1:web-service-request-version>" &_
" </v1:new-business-upload-release-request>" &_
"</soapenv:Body>" &_
"</soapenv:Envelope>"
End If
Next
Dim http
Set http = createObject("Msxml2.ServerXMLHTTP")
http.Open "POST", strUrl, False
http.setRequestHeader "Authorization", "Basic 123"
http.setRequestHeader "Content-Type", "text/xml"
http.send strRequest
If http.Status = 200 Then
WScript.Echo "RESPONSE : " & http.responseXML.xml
Else
WScript.Echo "ERRCODE : " & http.status
Your XML data is invalid. The opening <soapenv:Envelope> tag is missing the closing angular bracket, and the end-slash for the tag <soapenv:Header> tag is after the closing angular bracket.
Change this:
strRequest = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/""" &_
" xmlns:v1=""http://crsoftwareinc.com/xml/ns/titanium/newbiz/newbusinessuploadreleaseservice/v1_0""" &_
" xmlns:v11=""http://www.crsoftwareinc.com/xml/ns/titanium/common/v1_0""" &_
" <soapenv:Header>/" &_
...
into this:
strRequest = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/""" &_
" xmlns:v1=""http://crsoftwareinc.com/xml/ns/titanium/newbiz/newbusinessuploadreleaseservice/v1_0""" &_
" xmlns:v11=""http://www.crsoftwareinc.com/xml/ns/titanium/common/v1_0"">" &_
" <soapenv:Header/>" &_
...
Also, you use mm twice in the construction of dt:
dt = mm & dd & hh & mm
It probably should be
dt = mm & dd & hh & mn
If that doesn't fix the problem you may need to check the webserver logs (error 500 is a server-side error) and/or consult the API documentation to verify that the request you're sending has the correct form.
I have the string of the following format:
example 1: ABC,0,ABCD,ABC,ABC,ABC,ABC,ABC,11,ABC,ABC,toRemove,012,234
example 2: ABC,0,ABCD,ABC,ABC,ABC,ABC,ABC,11,ABC,ABC, toRemove,012,234
If the string contains 14 Values (instead of 13 values) separated by comma, then remove the 12. value
The second line above contains a white space, that should also removed if exists.
StringSplit has already a counter (element 0), so no need to use Ubound).
Like StringSplit converts a string to an array, ArrayToString converts an array back to a string.
#include <array.au3>
$tmp_line = "ABC,0,ABCD,ABC,ABC,ABC,ABC,ABC,11,ABC,ABC, ToRemove,012,234"
$line = StringSplit($tmp_line, ",")
If $line[0] = 14 Then
$new_line = ArrayToString($line, ",", 1, 11) & "," & ArrayToString($line, ",", 13)
Else
$new_line = $line ; shouldn't this be $new_line = $tmp_line ?
EndIf
MsgBox(0, $line[0], $tmp_line & #CRLF & $new_line)
Solved:
$line = StringSplit($tmp_line, ",")
$count_values = Ubound($line)
If $count_values = 14 Then
$new_line = $line[1] & "," & $line[2] & "," & $line[3] & "," & $line[4] & "," & $line[5] & "," & $line[6] & "," & $line[7] & "," & $line[8] & "," & $line[9] & "," & $line[10] & "," & $line[12] & "," & $line[13]
Else
$new_line = $line
EndIf