Why GetHDD Result "_____WD-WX4645DRTEE" , Add 5 Space . Where is the code problem?
I added _____ instead of 5 Space.
Function GetHDD() As String
Dim Wmi As Object, Disks As Object, Disk As Object
Set Wmi = GetObject("winmgmts:{impersonationLevel" & "=impersonate}!root\cimv2")
Set Disks = Wmi.ExecQuery("Select * from Win32_DiskDrive")
For Each Disk In Disks
If Len(Disk.SerialNumber) > Len(GetSerialNumber) Then GetSerialNumber = Disk.SerialNumber
Next
Set Disk = Nothing
Set Disks = Nothing
Set Wmi = Nothing
GetHDD = GetSerialNumber
Debug.Print GetHDD
End Function
Related
I was using the MOTO BIT Mdict as my dictionary component, putting all my translations in the Application object as per the below code, and it worked fine, until the component expired 2 days ago for unknown reasons, 12 years later on.
The MOTO Bit website is not replying - so now I seek help if anyone knows how I can reprogram the code below to use with the build in asp scripting.dictionary instead. Is it possible at all?
Function Write(strID, Comment)
If ValidNumber(strID) Then
If (IsObject(Application("Translation_" & StoryCountry)) = False) OR Debugf = True Then
SET objDic = Server.CreateObject("Multi.Dictionary")
'Load the translations into the dic object
set toRs = conn.execute("EXEC dbo.GetTranslationsByCountryID " & StoryCountry)
If Not toRs.Eof Then
tRow = toRs.GetRows()
For tx = 0 To UBound(tRow, 2)
IF objDic.Exists(tRow(0, tx)) THEN
ELSE
strTranslationKey = tRow(0, tx)
strTranslationText = tRow(1, tx)
objDic.Add strTranslationKey, strTranslationText
END IF
Next
SET Application("Translation_" & StoryCountry) = objDic
End If
Set toRs = Nothing
End If
Write = Application("Translation_" & StoryCountry)(strID)
Else
Write = "Invalid"
End If
End Function
Unfortunately, Lord Svendson, using Scripting.Dictionary objects at the Application level is not allowed. When you attempt to SET Application("Translation_" & StoryCountry) = objDic, it errors for this reason. You will need to find a workaround to using Scripting.Dictionary
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 2 years ago.
Improve this question
my code is
Public Function notcpuid()
Dim m As String
Const test = "BFEBF55555555"
m = GetCPUID
If m <> test Then
notcpuid = True
Else
notcpuid = False
End If
End Function
Function GetCPUID() As String
Dim cimv2, PInfo, PItem ' no idea what to declare these as
Dim PubStrComputer As String
PubStrComputer = "."
Set cimv2 = GetObject("winmgmts:\\" & PubStrComputer & "\root\cimv2")
Set PInfo = cimv2.ExecQuery("Select * From Win32_Processor")
For Each PItem In PInfo
Next PItem
GetCPUID = PItem.ProcessorID
End Function
Private Sub Workbook_Open()
If notcpuid Then
ThisWorkbook.Close
End If
End Sub
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
Why does it not work?
i want excel file protection by vba cpuid.
Declare the items as Object.
You also have your For Each loop out of order.
Function GetCPUID() As String
Dim cimv2 As Object
Dim PInfo As Object
Dim PItem As Object
Dim PubStrComputer As String
PubStrComputer = "."
Set cimv2 = GetObject("winmgmts:\\" & PubStrComputer & "\root\cimv2")
Set PInfo = cimv2.ExecQuery("Select * From Win32_Processor")
For Each PItem In PInfo
GetCPUID = PItem.ProcessorID
Next PItem
End Function
BTW, you do know that identical CPUs will return the same ID? Not the same as a serial number. For example:
Item Value
------ -----
Processor Name Intel(R) Core(TM) i7-7700 CPU # 3.60GHz
Code Name Kaby Lake
Info Intel64 Family 6 Model 158 Stepping 9
Maker GenuineIntel
ID BFEBFBFF000906E9
Max CPU Speed 3.6 GHz
Physical CPUs 1
Physical Cores 4
Logical Cores 8
Address Width 64
HyperThreading Enabled
VM Firmware Disabled
Socket U3E1
Update: Using Powershell I looked at the properties for the CPU_Object. It includes a Serial number but when checked on my PC I got this:
PS> $CPU_Object.serialnumber
To Be Filled By O.E.M.
HTH
My EXCEL VBA code builds up 1500+ instances of complex objects, always with good speed.
After all data have been processed my code cleans up, i.e. all objects and collections of them are getting set to NOTHING.
Sometimes this clean-up is fast (~10s), sometimes slow (>5 minutes).
I never start this code multiple times in the same session, i.e. I always close the workbook (all workbooks) and make sure Excel is closed.
There are no conditional formattings.
Screen updating is set to FALSE.
I use MS Office Professional Plus 2016.
Does anybody have an idea why it sometimes is fast and sometimes slow?
As some code is asked for here's the upper level clean-up loop for the superItems collection:
For idx = 1 To superItems.Count
Application.statusBar = thisFunction & ": " & superItems.Count - idx & " items left"
Set superItem = superItems(idx)
If Not (superItem Is Nothing) Then
superItem.clear
Set superItem = Nothing
End If
DoEvents
Next idx
Set superItems = Nothing
... and here's the method superItem.clear:
the superItem object holds an array (pArrTmxxItems) with pointers to item objects.
ub = UBound(pArrTmxxItems)
For idx = 0 To ub
Set item = pArrTmxxItems(idx)
If Not (item Is Nothing) Then
item.clear
Set item = Nothing
End If
Next idx
... item.clear looks like this:
the item object holds a collection pCAs of CA object instances, and (b) a collection pChildren of its own kind (i.e. aChild is of the same class as item)
If Not (pCAs Is Nothing) Then
For idx = 1 To pCAs.Count
Set CA = pCAs(idx)
If Not (CA Is Nothing) Then Set CA = Nothing 'jp171107
Next idx
Set pCAs = Nothing 'jp171107
End If
If Not (pChildren Is Nothing) Then
For idx = 1 To pChildren.Count
Set aChild = pChildren.item(idx)
aChild.clear
Set aChild = Nothing
Next idx
Set pChildren = Nothing 'jp171107
End If
Redeclare all the public variables. Every single one of them, except for the constants. Take care of the scope and do not pollute it.
Delete all the part of the code, setting stuff to nothing. The VBA Environment will do it for you. Automatically.
VBA code to monitor windows process displayed in task manager.
I am trying to get the RAM usage and CPU usage of an application and add those values in excel.
i tried using WMI class as below but howerver i am getting process ID.I am unable to retrieve RAM usage and CPU usage.
Can anyone help me in this?
Sub test2()
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process where caption='excel.exe'", , 48)
For Each objItem In colItems
Sheet1.Range("d2").Value = objItem.ProcessId
Next
Set colItems = objWMIService.ExecQuery( _"SELECT * FROM Win32_PerfFormattedData_PerfProc_Process where IDProcess=" & Sheet1.Range("d2").Value, , 48)
For Each objItem In colItems
Sheet1.Range("A1").Value = "PercentProcessorTime: " & objItem.PercentProcessorTime
Next
End Sub
If you choose to go the WMI route, then you might be after the WorkingSetSize property of the Win32_Process class:
WorkingSetSize Data type: uint64 Access type: Read-only Qualifiers:
DisplayName ("Working Set Size"), Units ("bytes") Amount of memory in
bytes that a process needs to execute efficiently—for an operating
system that uses page-based memory management. If the system does not
have enough memory (less than the working set size), thrashing occurs.
If the size of the working set is not known, use NULL or 0 (zero). If
working set data is provided, you can monitor the information to
understand the changing memory requirements of a process.
And the PercentProcessorTime of the Win32_PerfFormattedData_PerfProc_Process class:
PercentProcessorTime Data type: uint64 Access type: Read-only
Qualifiers: CookingType ("PERF_100NSEC_TIMER") , Counter
("PercentProcessorTime") , PerfTimeStamp ("TimeStamp_Sys100NS") ,
PerfTimeFreq ("Frequency_Sys100NS") Percentage of time that the
processor is executing a non-idle thread. This property was designed
as a primary indicator of processor activity. It is calculated by
measuring the time that the processor spends executing the thread of
the idle process in each sample interval, and subtracting that value
from 100%. (Each processor has an idle thread which consumes cycles
when no other threads are ready to run.) It can be viewed as the
percentage of the sample interval spent doing useful work. This
property displays the average percentage of busy time observed during
the sample interval. It is calculated by monitoring the time the
service was inactive, and then subtracting that value from 100%.
But you might also want to look at the SWbemRefresher object (https://msdn.microsoft.com/en-us/library/aa393838(v=vs.85).aspx).
Skeleton VBA code for you to work with:
Dim srvEx As SWbemServicesEx
Dim xlProcSet As SWbemObjectSet
Dim xlPerfSet As SWbemObjectSet
Dim objEx As SWbemObjectEx
Set srvEx = GetObject("winmgmts:\\.\root\CIMV2")
Set xlProcSet = srvEx.ExecQuery("SELECT * FROM Win32_Process WHERE name = 'EXCEL.EXE'")
Set xlPerfSet = srvEx.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfProc_Process WHERE name = 'EXCEL'")
For Each objEx In xlProcSet
Debug.Print objEx.Name & " RAM: " & objEx.WorkingSetSize / 1024 & "kb"
Next
For Each objEx In xlPerfSet
Debug.Print objEx.Name & " CPU: " & objEx.PercentProcessorTime & "%"
Next
These functions allow to monitor RAM and CPU usage as requested. Notice that the application name in one is case sensitive and includes the extension, in the other is case insensitive and does not include the extension.
Debug.Print ProcessCpuUsage("Excel")
Debug.Print ProcessMemoryUsage("EXCEL.EXE") / 1024
Function ProcessCpuUsage(ProcessName As String) As Double
Dim Wmi As Object, Processes As Variant, Process As Object
Set Wmi = GetObject("winmgmts:")
Set Processes = Wmi.ExecQuery("SELECT PercentProcessorTime FROM win32_PerfFormattedData_PerfProc_Process WHERE Name='" & ProcessName & "'")
For Each Process In Processes
Exit For
Next Process
ProcessCpuUsage = Process.PercentProcessorTime
End Function
Function ProcessMemoryUsage(ProcessName As String) As Double
Dim Wmi As Object, Processes As Variant, Process As Object
Set Wmi = GetObject("winmgmts:")
Set Processes = Wmi.ExecQuery("SELECT WorkingSetSize FROM Win32_Process WHERE Name='" & ProcessName & "'")
For Each Process In Processes
Exit For
Next Process
ProcessMemoryUsage = Process.WorkingSetSize
End Function
I am seeing a timeout error when running a query from Excel vba
The query takes <2 seconds from the SQL Server Management Studio, but from vba the timeout happens at 2 minutes with nothing returned
Is there something i am not doing right setting up the Command object? I have noticed that ADODB seems to be slower but never anything like this
The query joins several tables and does some other calculations, but going from 1.5 seconds to >2 minutes must mean something in the vba that I have missed
This is my vba connection string code:
If svrCon Is Nothing Then
Set svrCon = New ADODB.Connection
End If
If Not CheckServerConnectionState Then
conStr = "Provider=SQLOLEDB;Data Source=ussantapps332;" & _
"Initial Catalog=Global_OEE_Data_Capture_Dev;User Id=sqluser;Password=*****;"
' Open the connection
svrCon.ConnectionTimeout = 0
svrCon.Open conStr
End If
This is my vba SELECT code:
Dim cmd As ADODB.Command
Dim par As ADODB.Parameter
Dim rst As ADODB.Recordset
' Create command object
Set cmd = New ADODB.Command
cmd.CommandTimeout = 120
cmd.ActiveConnection = svrCon
cmd.CommandText = sql
' Create parameter object
If IsArrayInitialized(params) Then
For x = 0 To UBound(params)
If IsNull(params(x, 1)) Then
Set par = cmd.CreateParameter(Type:=params(x, 0), Size:=1)
Else
Set par = cmd.CreateParameter(Type:=params(x, 0), Size:=Len(params(x, 1)) + 1)
End If
par.Value = params(x, 1)
cmd.Parameters.Append par
Set par = Nothing
DoEvents
Next
End If
' Open recordset object
On Error GoTo ExecuteError
Debug.Print Format(Now, "hh:mm:ss")
Set rst = cmd.Execute
Debug.Print Format(Now, "hh:mm:ss")
On Error GoTo 0
The sql string and parameters are passed into the function, the connection is opened from another method
The query is:
SELECT U.UnitsID, L.LineName, V.VSName, O.OperatorShift, O.LineLeader, O.CotyOps, O.TempOps, U.WorkOrder, U.ProductCode,
S.ProdDesc, U.TimeLineStart, U.TimeLineEnd, U.UnitsProduced, U.ActLineSpeed, U.TgtLineSpeed, SUM(CASE WHEN C.DTIncludedInOEE = 0 THEN D.DowntimeLength ELSE 0 END),
U.OfflineTaskID, R.Rate, S.LabHrsPerThou, S.PHeads, T.TgtOEE, T.TgtEff, T.TgtProd
FROM dataUnits U
LEFT JOIN dataOperatorNames O ON O.OperatorID = U.OperatorNameID
INNER JOIN setupLines L ON U.LineID = L.LineID
INNER JOIN setupValueStreams V on V.VSID = L.VSID
INNER JOIN setupPUs P ON V.PUID = P.PUID
LEFT JOIN dataDowntimes D ON U.UnitsID = D.UnitsID
LEFT JOIN setupDowntimes sD ON D.DTID = sD.DTID
LEFT JOIN setupDowntimeCats C ON sD.DTCatID = C.DTCatID
LEFT JOIN (SELECT VSID, AVG(RateVal) Rate
FROM dataRates WHERE FYStart >= '2014-07-01' AND FYStart < '2015-07-01'
GROUP BY VSID) R ON R.VSID = L.VSID
LEFT JOIN dataStandards S ON S.ProdCode = U.ProductCode
LEFT JOIN (SELECT LineID, AVG(TgtOEE) TgtOEE, AVG(TgtEff) TgtEff, AVG(TgtProd) TgtProd
FROM dataTargets WHERE TgtMonth >= '2015-03-01' AND TgtMonth < '2015-04-01'
GROUP BY LineID) T ON L.LineID = T.LineID
WHERE (S.SAPVersion = (SELECT MIN(SAPVersion) FROM dataStandards s2 WHERE s2.ProdCode = S.ProdCode)
OR S.SAPVersion IS NULL)
AND P.SiteID = 2 AND U.TimeLineStart >= '2015-03-05 23:00' AND U.TimeLineStart < '2015-03-31 23:00'
GROUP BY U.UnitsID, L.LineName, V.VSName, O.OperatorShift, O.LineLeader, O.CotyOps, O.TempOps, U.WorkOrder, U.ProductCode, S.ProdDesc, U.TimeLineStart,
U.TimeLineEnd, U.UnitsProduced, U.ActLineSpeed, U.TgtLineSpeed, U.OfflineTaskID, R.Rate, S.LabHrsPerThou, S.PHeads, T.TgtOEE, T.TgtEff, T.TgtProd
ORDER BY U.TimeLineStart ASC
The discussion on the chat showed that:
The problem occurs only while connecting to the remote database.
The old SQLOLEDB provider is used.
I suggested to give a chance to a newer provider SQLNCLI which should be more effective while communicating with MSSQL. When a connection string was modified the execution time dropped from 2 minutes to 3 seconds.