Lấy thông số cpu của máy tính ra một cell trong sheet (2 người xem)

[mitomcombui]

Chào mọi người, mình có một bài toán thế này: Mình cần lấy thông số CPU của máy tính ra một ô trong 1 sheet chỉ bằng 1 cái click chuột ngay trên Nút bấm(có chứa đường link) trong sheet đó hoặc sheet khác. Mình đã lấy được thông số CPU rồi nhưng là một form hiển thị độc lập so với sheet đó. Vấn đề bây giờ là chuyển các thông số đó vào một ô cụ thể.
Đây là file mình đã lấy được thông số CPU: View attachment Book1.xls
Nhờ mọi người giúp đỡ. Cảm ơn nhiều!!!

 

[PhanTuHuong]

Thầy ơi! Bình tĩnh ạ! Công nhận trên diễn đàn thì vấn đề bảo mật là quá tầm thường.
Nhưng đôi khi ở cty hay 1 doanh nghiệp nào đó thì mình cũng có những cái riêng tư của một mảng nhất định nào đó Thầy ạ!
Ví dụ file tính lương của bộ phận kế toán hay nhân sự chẳng hạn em cũng muốn có ý tưởng chỉ mở trong được 1 số máy của bộ phận này hoặc bộ phận kia thôi còn máy khác sớ rớ vào thì die luôn.
Cái này mình chống người ngay thôi Thầy ạ! Chứ chống cao thủ thì ... @@ chắc chịu... nhất là gặp phải GPE chưa đầy 3S...
-------
Theo Em việc học hỏi trao đổi cũng có nhiều mục đích do vậy mong Thầy bớt giận ạ...
Hix hôm nay Em mới sờ đến thông tin của CPU đấy chứ bình thường em có biết và quan tâm gì đâu... hihi

Miễn Thầy Trò ở đây nhé! Vấn đề này đã bàn ở GPE nhiều lần rồi!!

PS: Gần đây tôi không còn hào hứng trả lời vì những thành viên ảo, suốt ngày vào chỉ nhờ vả! Trình độ thì có hạn mà chỉ tính giấu giếm

 

[thanh tong]

Bây giờ bạn kiểm tra bằng tay thế này nhé:
- Bấm tổ hợp phím Lá cờ Windows + R và gõ vào dòng lệnh: cmd rồi Enter
- Trong cửa sổ cmd vừa mở, bạn gõ dòng lệnh này vào: wmic bios get serialnumber rồi Enter
Xem thử nó ra cái gì? Chụp hình kết quả gửi lên tôi xem nhé
Nếu công đoạn kiểm tra bằng tay này thành công thì tôi sẽ có cách viết code (dựa vào dòng lệnh trên). Bằng ngược lại thì.. ngu luôn

Đây rồi! Bác Du xem hộ

 

[thanh tong]

Bây giờ bạn kiểm tra bằng tay thế này nhé:
- Bấm tổ hợp phím Lá cờ Windows + R và gõ vào dòng lệnh: cmd rồi Enter
- Trong cửa sổ cmd vừa mở, bạn gõ dòng lệnh này vào: wmic bios get serialnumber rồi Enter
Xem thử nó ra cái gì? Chụp hình kết quả gửi lên tôi xem nhé
Nếu công đoạn kiểm tra bằng tay này thành công thì tôi sẽ có cách viết code (dựa vào dòng lệnh trên). Bằng ngược lại thì.. ngu luôn

Em gửi hình nhưng không được Bác Du thông cảm.
Em thử dòng lênh trên của bác cũng không đươc nó chỉ hiện dưới dòng lệnh mình gõ vào là "serialnumber"

 

[KUMI]

Miễn Thầy Trò ở đây nhé! Vấn đề này đã bàn ở GPE nhiều lần rồi!!

Thầy ạ! Có lẽ Kumi không có duyên được đọc những bài mà Thầy đã nêu ởi trên rồi.
Riêng với Kumi cũng phải xét theo từng trường hợp mới dám xưng hô.
Nếu cấp độ từ 1 sao vàng không xoay trở lên mà có nhiều đóng góp cho GPE thì Kumi không ngại gọi là Thầy Cô mặc dù không biết tuổi tác ra sao.
Hơn nữa với các Mod hay BQT là những người được chọn trong hàng chục nghìn người... thì lại càng là những người truyền giáo tốt nhất,luôn nỗ lực tìm cách đem lại nhiều kiến thức thật bổ ích cho cộng đồng GPE chẳng nhẽ không đáng để được gọi là Thầy sao ạ!
Còn ngoài ra cũng phải qua những bài viết của họ và cách xưng hô của các thành viên trong GPE về họ thì Kumi mới có thể xưng hô.
Còn lại luôn là Anh là Chị!
----------------
Cảm ơn Thầy!

 

[thanh tong]

Tôi đã làm từ lâu rồi, share trên diễn đàn GPE rồi, pm bán được tiền cơ! Bạn hãy tỏ trình độ mình đã rồi hãy tính nhé... Ghét nhất những ai suốt ngày vào hỏi giấu giếm này nọ!!

Tôi chẳng biết "PhanTuHuong" nghĩ như thế nào về câu hỏi của tôi mà lại nói như vậy!
Chẳng là tôi cũng rất thích về VBA nhưng tôi không học qua trường lớp nào cả mà chỉ là tự học tự tìm tòi thôi, chính vì vậy tôi mới hỏi để biêt chứ tôi có giấu gì đâu.

 

[siwtom]

Nếu bạn thanh tong và KUMI không đọc được SerialNumber thì sửa code của ndu

Function GetBoardSerial()
  Dim obj
  Application.Volatile
  With CreateObject("winmgmts:{impersonationLevel=impersonate}")
    For Each obj In .InstancesOf("Win32_BIOS")
      GetBoardSerial = obj.[B][COLOR=#ff0000]SerialNumber[/COLOR][/B]
    Next
  End With
End Function

thành

Function GetBoardSerial()
  Dim obj
  Application.Volatile
  With CreateObject("winmgmts:{impersonationLevel=impersonate}")
    For Each obj In .InstancesOf("Win32_BIOS")
      GetBoardSerial = obj.[B][COLOR=#ff0000]Name[/COLOR][/B]    ' hoac obj.[B][COLOR=#ff0000]Caption[/COLOR][/B]
    Next
  End With
End Function

-------------
Nếu ai muốn xem "trong trái ổi có thứ gì" thì chạy code sau. Tôi mới viết và test qua loa nên không biết đã chuẩn chưa. Nếu ai thích "voc" thì xin mời tham chiếu tới Microsoft WMI Scripting V1.2 Library và vọc nhé. Tôi phủi tay.

Tôi chọn Name (hoặc Caption, hoặc ...) cũng là do đã chạy code và xem xong "trong trái ổi có thứ gì"

Private Const wbemFlagUseAmendedQualifiers = &H20000

Function GetObjectProp(ByVal Win32ClassName As String)
Dim service As Object, obj As Object, WbemLocator As Object, objItem As Object, instance As Object
Dim Arr, r As Long, c As Long, prop
On Error Resume Next
    Set WbemLocator = CreateObject("WbemScripting.SWbemLocator")
    Set service = WbemLocator.ConnectServer(".", "root\CIMV2")
    If Not service Is Nothing Then
        Set obj = service.Get(Win32ClassName, wbemFlagUseAmendedQualifiers, Nothing)
        If Not obj Is Nothing Then
            ReDim Arr(0 To obj.Instances_.Count, 1 To 1)
            For Each instance In obj.Instances_
                If r = 0 Then ReDim Preserve Arr(0 To obj.Instances_.Count, 1 To instance.Properties_.Count)
                r = r + 1
                c = 0
                For Each objItem In instance.Properties_
                    c = c + 1
                    Arr(0, c) = objItem.Name
                    Arr(r, c) = objItem.Value
                Next objItem
            Next instance
            GetObjectProp = Arr
        End If
    End If
End Function

Sub test()
Dim Arr
    Sheet1.UsedRange.ClearContents
    Arr = GetObjectProp("Win32_Bios")
    If IsArray(Arr) Then Range("A1").Resize(UBound(Arr) + 1, UBound(Arr, 2)).Value = Arr
End Sub

Các giá trị cho Win32ClassName:

Win32_PhysicalMemory
Win32_Processor
[B][COLOR=#ff0000]Win32_Bios[/COLOR][/B]
Win32_VideoController
Win32_SoundDevice
Win32_ComputerSystem
Win32_Process
Win32_OperatingSystem
Win32_Group
Win32_CDROMDrive
Win32_PnPEntity
Win32_PointingDevice
Win32_SystemEnclosure
Win32_USBHub
Win32_Product
Win32_LocalTime
Win32_TimeZone
Win32_Desktop
Win32_DesktopMonitor
Win32_StartupCommand
Win32_LogicalDisk
Win32_NTEventLogFile
Win32_NetworkAdapterConfiguration
Win32_Printer
Win32_Service
Win32_DiskDrive
Win32_DiskPartition
Win32_DiskDriveToDiskPartition
WIN32_BaseBoard

 

[KUMI]

Cảm ơn Thầy siwtom ,Con đã thầy có kết quả hiển thị.
nhưng con cũng không biết kết quả có đúng như thế này không ạ!



-----------------
Xin hỏi thên Thầy Cô và Anh Chị trong GPE, Em muốn kiểm tra lại các thông tin hiển thị trong file là đúng hay sai thì phải lấy thông tin ở đâu để so sánh ạ!
Nếu máy tính lắp 2 ổ cứng trở lên thì Cái seria của HDD trong hình ảnh đính kèm là của ổ lưu file hay là ổ window ạ!
Xin cảm ơn!

 

[thanh tong]

Cảm ơn SiwTom!
Tôi thử code của anh thì có thấy sr của main rồi OK

 

[siwtom]

Cảm ơn Thầy siwtom ,Con đã thầy có kết quả hiển thị.
nhưng con cũng không biết kết quả có đúng như thế này không ạ!

View attachment 104879

-----------------
Xin hỏi thên Thầy Cô và Anh Chị trong GPE, Em muốn kiểm tra lại các thông tin hiển thị trong file là đúng hay sai thì phải lấy thông tin ở đâu để so sánh ạ!
Nếu máy tính lắp 2 ổ cứng trở lên thì Cái seria của HDD trong hình ảnh đính kèm là của ổ lưu file hay là ổ window ạ!
Xin cảm ơn!

Cái số HDD mà bạn đọc ra đó (Readserienumber) không phải là số unique của đĩa cứng vật lý.
Cái số đó là Label của đĩa lôgíc / phân vùng. Ở trường hợp này ắt là Label của "đĩa" C.

Bạn có 1 đĩa vật lý mua từ cửa hàng về nhưng bạn chia thành 3 đĩa / 3 phân vùng C, D, E thì mỗi "đĩa" C, D, E có 1 Label và những Label này thì mỗi lần Format phân vùng thì bác Bill lại cho 1 số khác.

Cái số bất di bất dịch và luôn đặc trưng cho đĩa cứng vật lý thì phải đọc bằng hàm khác. Bạn tự tìm trên GPE.

Nếu bạn muốn xem code của tôi thì bạn gọi hàm (bài #46) với tham số là "Win32_PhysicalMedia". Bạn có bao nhiêu đĩa cứng vật lý thì nó ra hết.

 

[namkpac]

Cái số HDD mà bạn đọc ra đó (Readserienumber) không phải là số unique của đĩa cứng vật lý.
Cái số đó là Label của đĩa lôgíc / phân vùng. Ở trường hợp này ắt là Label của "đĩa" C.

Bạn có 1 đĩa vật lý mua từ cửa hàng về nhưng bạn chia thành 3 đĩa / 3 phân vùng C, D, E thì mỗi "đĩa" C, D, E có 1 Label và những Label này thì mỗi lần Format phân vùng thì bác Bill lại cho 1 số khác.

Cái số bất di bất dịch và luôn đặc trưng cho đĩa cứng vật lý thì phải đọc bằng hàm khác. Bạn tự tìm trên GPE.

Nếu bạn muốn xem code của tôi thì bạn gọi hàm (bài #46) với tham số là "Win32_PhysicalMedia". Bạn có bao nhiêu đĩa cứng vật lý thì nó ra hết.

Các anh cho em hỏi với: với đoạn code trên thì nếu máy có 2 ID CPU thì nó sẽ báo 2 lần ID CPU vậy giờ em muốn lấy 1 lần thôi thì sửa code thế nào? Em hỏi thêm tý nữa, vì sao khi ghost máy thì nó báo có 2 ID CPU còn khi cài thủ công thì nó chỉ báo có 1 ID CPU

 

[namkpac]

Miễn Thầy Trò ở đây nhé! Vấn đề này đã bàn ở GPE nhiều lần rồi!!

PS: Gần đây tôi không còn hào hứng trả lời vì những thành viên ảo, suốt ngày vào chỉ nhờ vả! Trình độ thì có hạn mà chỉ tính giấu giếm

Trình độ thì có hạn mà chỉ tính giấu giếm

 

[tvducgt]

bạn thử gộp 3 đoạn code lại như thế này xem sao

Sub GetBoardSerial()
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
Set objs = WMI.ExecQuery("Select * from Win32_BaseBoard")
For Each obj In objs
Sheet1.[B1].Value = obj.SerialNumber
Next
 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
 For Each objItem In colItems
 Sheet1.[B2].Value = objItem.ProcessorId
 Next
     Dim fso As Object, Drv As Object
               Set fso = CreateObject("Scripting.FileSystemObject")
               Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else
                      DriveSerial = -1
                  End If
              End With
             
              Set Drv = Nothing
              Set fso = Nothing
              Sheet1.[B3].Value = DriveSerial
     End Sub

Nếu muốn xuất thời gian tại thời điểm lấy thông tin CPu vào ô B4 thì phải làm như thế nào bạn?
Tks

 

[quick87]

Nếu muốn xuất thời gian tại thời điểm lấy thông tin CPu vào ô B4 thì phải làm như thế nào bạn?
Tks

bạn insert thêm hàm now phía dưới code nhé
đại khái nó như thế này:

Sub GetBoardSerial()
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
Set objs = WMI.ExecQuery("Select * from Win32_BaseBoard")
For Each obj In objs
Sheet1.[B1].Value = obj.SerialNumber
Next
 Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
 For Each objItem In colItems
 Sheet1.[B2].Value = objItem.ProcessorId
 Next
     Dim fso As Object, Drv As Object
               Set fso = CreateObject("Scripting.FileSystemObject")
               Set Drv = fso.GetDrive(Environ("SystemDrive"))
              With Drv
                  If .IsReady Then
                      DriveSerial = Abs(.SerialNumber)
                  Else
                      DriveSerial = -1
                  End If
              End With
             
              Set Drv = Nothing
              Set fso = Nothing
              Sheet1.[B3].Value = DriveSerial
              Sheet1.[B4].Value = Now()
     End Sub