Lấy danh sách tên các máy tính đang hoạt động trong mạng LAN (2 người xem)

[viehoai]

Các anh chị vui lòng giúp em code VBA lấy danh sách tên các máy tính đang hoạt động trong mạng LAN (bao gồm cả trong nhóm Mshome và Workgroup). Kết quả có thể là Array hoặc xuất ra bảng tính.
Xin cảm ơn các anh chị.

 

[doveandrose]

Đó là phương pháp làm tương thích 32 và 64-bit với các hàm API. Có thể máy bạn đang bị lỗi ở vấn đề khác? Các bạn dùng Excel 64-bit có bị lỗi vậy không?

đầu tiên anh khai báo

Public Declare PtrSafe Function NetServerEnum Lib "netapi32" _
  (ByVal servername As LongPtr, _
   ByVal level As LongPtr, _
   buf As Any, _
   ByVal prefmaxlen As LongPtr, _
   entriesread As[SIZE=4][B] LongPtr[/B][/SIZE], _
   totalentries As LongPtr, _
   ByVal servertype As LongPtr, _
   ByVal domain As LongPtr, _
   resume_handle As LongPtr) As LongPtr

nhưng vào trong hàm anh lại khai báo

Dim dwEntriesread   As [SIZE=4][B]Long[/B][/SIZE]

thì đương nhiên là Type Mismatch ngay lập tức rồi , đây là hệ quả của việc viết code mà không có máy để Test nên em mới khẳng định anh mới chỉ viết code chứ chưa có test .
Bỏ qua chuyện này , đây mới là cái cần lưu ý , để thực hiện được hàm Copymemory trên máy 64bit thì địa chỉ bộ nhớ (bufptr) và các thành phần trong Struc : sv100_platform_id , sv100_name bắt buộc phải mang kiểu LongPtr

Như vậy đây sẽ là khai báo trong phần #IF

#If VBA7 Then
Public Declare PtrSafe Function NetServerEnum Lib "netapi32" _
  (ByVal servername As LongPtr, _
   ByVal level As LongPtr, _
   buf As Any, _
   ByVal prefmaxlen As LongPtr, _
   entriesread As Long, _
   totalentries As Long, _
   ByVal servertype As Long, _
   ByVal domain As LongPtr, _
   resume_handle As Long) As Long


Public Declare PtrSafe Function NetApiBufferFree Lib "netapi32" _
   (ByVal Buffer As LongPtr) As LongPtr


Public Declare PtrSafe Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, uFrom As Any, _
   ByVal lSize As LongPtr)
   
Public Declare PtrSafe Function lstrlenW Lib "kernel32" _
  (ByVal lpString As LongPtr) As Long
  
Public Type SERVER_INFO_100
  sv100_platform_id As LongPtr
  sv100_name As LongPtr
End Type


Private ResultAddress As LongPtr


Public Function GetPointerToByteStringW(ByVal dwData As LongPtr) As String
   Dim tmp() As Byte
   Dim tmplen As Long
   
   If dwData <> 0 Then
   
      tmplen = lstrlenW(dwData) * 2
      
      If tmplen <> 0 Then
      
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
     End If
   End If
End Function

#Else

#End If

hàm GetPointerToByteStringW cũng bị đưa vào khối này luôn vì nó nhận tham số là kiểu LongPtr .
Giờ anh xem thử trong file này có hoạt động trên máy 32bit chăng ? tới lượt em không có máy 32bit để test

 

[Nguyễn Duy Tuân]

Chỉ cần bạn cửa thay thế vào nhánh #VBA7 còn nhánh sau #Else để như cũ là ok thôi. Mình không có Office 64-bit nên dựa theo nguyên lý viết chứ chưa test

 

[Kiều Mạnh]

Nhà Mình có 2 Cái máy Đặt tên Giống nhau: KieuManh-PC

Buồn Buồn Mình thử code nào chạy thấy cũng Báo có 1 cái ....