Lấy danh sách tên các máy tính đang hoạt động trong mạng LAN (1 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ị.

 

[VMH0307]

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ị.

Bạn có thể dùng lệnh Net view trong msdos
Còn thực hiện trong VBA có thể dùng:
[gpecode=vb]MsgBox CreateObject("WScript.Shell").Exec("net view").StdOut.ReadAll[/gpecode]
hoặc lưu ra file text kết quả, việc còn lại là xử lý dữ liệu từ file text đó.

 

[befaint]

Sao import ra file text không được nhỉ?

shell(net view > "C:\listcp.txt")

Run ở CMD thì import được.

 

[VMH0307]

Sao import ra file text không được nhỉ?

shell(net view > "C:\listcp.txt")

Run ở CMD thì import được.

Bạn thử thế này:

Shell "cmd.exe /c net view > C:\listcp.txt"

 

[viehoai]

Cảm ơn VMH0307, sau khi chuyển file text ta có thể sử dụng bài này của anh quanghai1969 để xuất ra bảng tính.

 

[viehoai]

Bạn thử thế này:

Shell "cmd.exe /c net view > C:\listcp.txt"

Hình như lệnh này không lấy trong nhóm Mshome.

 

[VMH0307]

Hình như lệnh này không lấy trong nhóm Mshome.

Tôi cũng không rõ danh sách các máy tính trong mạng lan của bạn như thế nào. Hiện tại ở cơ quan tôi có duyệt qua và có hiện các pc và serve trên lan.
Nếu vẫn chưa đạt nhu cầu của bạn, có lẽ cần làm theo hướng khác, có khi dùng thêm một số hàm API chăng (có thể là: WNetOpenEnum, WNetEnumResource).

 

[viehoai]

Tôi cũng không rõ danh sách các máy tính trong mạng lan của bạn như thế nào. Hiện tại ở cơ quan tôi có duyệt qua và có hiện các pc và serve trên lan.
Nếu vẫn chưa đạt nhu cầu của bạn, có lẽ cần làm theo hướng khác, có khi dùng thêm một số hàm API chăng (có thể là: WNetOpenEnum, WNetEnumResource).

Mình không biết dùng hàm API. Mong bạn tiếp tục giúp đỡ

 

[Nguyễn Duy Tuân]

Lấy danh sách máy tính online trong mạng LAN - Kỹ thuật lập trình API trong VBA

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ị.

Mình cung cấp cho bạn giải pháp lập trình API để có một kết quả lấy được danh sách máy tính online trong mạng LAN.

[GPECODE=vb]
Sub Danh_sach_may_tinh_trong_mang()
On Error GoTo ErrHandler:

Columns(1).Clear
Cells(1, 1).Value = "Chuong trinh dang lay danh sach may tinh trong mang. Neu co loi lien he duytuan@bluesofts.net ..."

Dim compNames() As String

compNames = GetCommServers(vbNullString, SV_TYPE_ALL)

Dim compName As String
Dim x As Integer, I As Integer

I = 1
Cells(I, 1).Value = "Danh sach may tinh trong mang"
For x = LBound(compNames) To UBound(compNames)
If Trim(compNames(x)) <> "" Then
I = I + 1
Cells(I, 1).Value = compNames(x)
End If
Next

MsgBox "Co " & I - 1 & " may tinh dang online trong mang LAN.", vbInformation

Exit Sub

ErrHandler:
MsgBox Err.Description & vbCrLf & "Neu co co loi lien he duytuan@bluesofts.net"

End Sub
[/GPECODE]

 

[doveandrose]

Mình cung cấp cho bạn giải pháp lập trình API để có một kết quả lấy được danh sách máy tính online trong mạng LAN.

Dạ cám ơn anh , nhưng sao em bấm nút nó hổng lấy được danh sách máy tính , mà chỉ lấy được bảng thông báo :
Microsoft Excel has Stopped working

 

[Nguyễn Duy Tuân]

Dạ cám ơn anh , nhưng sao em bấm nút nó hổng lấy được danh sách máy tính , mà chỉ lấy được bảng thông báo :
Microsoft Excel has Stopped working

Của bạn là Excel 32 hay 64/bit vậy?

 

[doveandrose]

Của bạn là Excel 32 hay 64/bit vậy?

window 8.1 x64 bit đó anh

 

[Nguyễn Duy Tuân]

window 8.1 x64 bit đó anh

Quan trọng Excel 32 hay 64. Mình sẽ upload code tương thích cả 2 nền tảng 32 và 64-bit.

 

[VMH0307]

Quan trọng Excel 32 hay 64. Mình sẽ upload code tương thích cả 2 nền tảng 32 và 64-bit.

Xin hỏi anh, code của anh đã xử lý được vấn đề của viehoai chưa anh? (do máy em chưa đủ cơ hội để test các trường hợp)

Hình như lệnh này không lấy trong nhóm Mshome.

 

[doveandrose]

Quan trọng Excel 32 hay 64. Mình sẽ upload code tương thích cả 2 nền tảng 32 và 64-bit.

à vâng , em xài Microsoft Office Professional Plus 2016 x64 (Product Activated)

 

[Nguyễn Duy Tuân]

Xin hỏi anh, code của anh đã xử lý được vấn đề của viehoai chưa anh? (do máy em chưa đủ cơ hội để test các trường hợp)

Mạng của mình chỉ có 1 domain nhưng cách lập trình API của mình là quét tất cả các máy tính của các domain trong mạng.

Mọi người dùng các dịch vụ của Windows không nên dùng hàm VBA GetObject() vì nó bị lỗi ở chế độ chạy ứng dụng mức an toàn (chuẩn của Windows Vista trở lại đây).

 

[Nguyễn Duy Tuân]

Lấy danh sách máy tính online trong mạng LAN - Kỹ thuật lập trình API trong VBA

Mình gửi lại phiên bản lấy danh sách tên máy tính đang online trong mạng LAN chạy trong Excel 32 và 64-bit.

 

[doveandrose]

Mình gửi lại phiên bản lấy danh sách tên máy tính đang online trong mạng LAN chạy trong Excel 32 và 64-bit.

thực sự thì anh chỉ thay Long thành LongPtr thôi chứ chưa từng thử trên máy 64 bit đúng không ? cũng không sao , nay mai rảnh em xem lại xem Crash ở đâu , vì có 1 số hàm API khi ở máy 32 bit bình thường nhưng cứ chạy trên máy 64 bit là Crash luôn dù cho thay kiểu gì đi nữa .

 

[Nguyễn Duy Tuân]

thực sự thì anh chỉ thay Long thành LongPtr thôi chứ chưa từng thử trên máy 64 bit đúng không ? cũng không sao , nay mai rảnh em xem lại xem Crash ở đâu , vì có 1 số hàm API khi ở máy 32 bit bình thường nhưng cứ chạy trên máy 64 bit là Crash luôn dù cho thay kiểu gì đi nữa .

Đó 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?

 

[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?

cái đó chỉ là vòng gửi xe thôi anh . Chú ý : các bài viết ở trên em không đề cập tới vấn đề Type Missmatch
Type Mismatch và Crash là 2 vấn đề khác nhau , với hàm API Copymemory thì phải cẩn thận , và phải có máy 64bit thật mới test được mình sai ở đâu , và em sẽ nêu rõ ở bài viết tiếp theo ngay sau đây , đây cũng là bài học cho chúng ta cùng rút kinh nghiệm

 

[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 ....