Xác định file tồn tại (File exists) trên mạng LAN bị chậm

[Nhattanktnn]

Chào các bác, các anh chị!
Em vừa viết code liên quan đến lấy hình ảnh trên một máy khác trong mạng Lan (mạng nội bộ công ty), phần lấy hình ảnh thì em không đề cập vào đây, chỉ có vấn đề ở chỗ xác định file đó tồn tại hay không thì có vấn đề thế này:
- Nếu là máy cần lấy ảnh (trong mạng nội bộ) đang mở thì mọi việc diễn ra suôn sẻ
- Nếu máy đó đã tắt, tức không kết nối được thì code xác định file tồn tại hay không lại xử lý quá lâu
Chạy lần đầu tới 43 giây, lần sau không hiểu nó có nhớ gì hay không nhưng chạy nhanh hơn
Trong code xác định sự tồn tại của file thì em tìm hiểu có 3 kiểu: dùng Dir, FSO hoặc API. Vì dùng Dir không áp dụng cho đường dẫn tiếng Việt nên em không nghiên cứu gì thêm nó
Nói thêm là đường dẫn phải là một máy có thật trên mạng LAN thì nó mới lâu, còn lấy đường dẫn giả thì nó cũng vài giây thôi
Câu hỏi của em là: Có cách nào xử lý vấn đề này cho nó nhanh hơn không? Tầm 1,2 giây gì đó thì trong khoảng chấp nhận được chứ 43 giây thì quá lớn

Private Declare Function GetFileAttributesW Lib "kernel32.dll" (ByVal lpFileName As Long) As Long

Public Function FileExistsAPI(ByRef sFileName As String) As Boolean
    Select Case (GetFileAttributesW(StrPtr(sFileName)) And vbDirectory) = 0&
    Case True
        FileExists = True
    Case Else
        FileExists = False
    End Select
End Function
Function FileExistsFSO(ByVal filename As String) As Boolean
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    FileExistsFSO = fso.FileExists(filename)
    Set fso = Nothing
End Function
Sub a()
Dim xpath As String, t As Double
t = Timer
xpath = "\\plan10\01234.jpg"
MsgBox "FileExistsAPI : " & FileExistsAPI(xpath) _
        & vbCrLf & "Time : " & Timer - t
t = Timer
'MsgBox "FileExistsFSO : " & FileExistsFSO(xpath) _
        & vbCrLf & "Time : " & Timer - t
End Sub

 

[ongke0711]

Chào các bác, các anh chị!
Em vừa viết code liên quan đến lấy hình ảnh trên một máy khác trong mạng Lan (mạng nội bộ công ty), phần lấy hình ảnh thì em không đề cập vào đây, chỉ có vấn đề ở chỗ xác định file đó tồn tại hay không thì có vấn đề thế này:
- Nếu là máy cần lấy ảnh (trong mạng nội bộ) đang mở thì mọi việc diễn ra suôn sẻ
- Nếu máy đó đã tắt, tức không kết nối được thì code xác định file tồn tại hay không lại xử lý quá lâu
Chạy lần đầu tới 43 giây, lần sau không hiểu nó có nhớ gì hay không nhưng chạy nhanh hơn
Trong code xác định sự tồn tại của file thì em tìm hiểu có 3 kiểu: dùng Dir, FSO hoặc API. Vì dùng Dir không áp dụng cho đường dẫn tiếng Việt nên em không nghiên cứu gì thêm nó

Bạn phải tách dường dẫn để lấy IP hoặc tên máy kết nối tới sau đó dùng Ping để xem nó có tắt/mở trước rồi mới kiểm tra tới file có tồn tại hay không.

 

[Ngày mai trời lại sáng]

Bác tham khảo thêm:

Option Explicit
Function PingIP(ByVal IP As String) As Boolean
    Dim objWMIService, colItems, objItem
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_PingStatus Where timeout = 1000 and Address='" & IP & "'")
    For Each objItem In colItems
        If objItem.StatusCode = 0 Then
            PingIP = True
        Else
            PingIP = False
        End If
    Next objItem
End Function

Sub testPingIP()
    Dim bl As Boolean
    Const SeverName As String = "192.168.252.99"
    bl = PingIP(SeverName)
    If bl = True Then
        'lam gi do
    End If
End Sub

 

[befaint]

Thử cái này (bài #2) xem nhanh hơn không?

Kiểm tra kết nối ổ đĩa mạng bằng VBA

Em đang dùng ADO để lấy dữ liệu 1 từ file .csv trên ổ đĩa mạng (Ví dụ: \\192.168.1.110\TaiLieu\abc.csv) và đẩy vào SQL server database (VD: IP của server Database 192.168.2.220) Có rất nhiều lý do mà kết nối đến ổ đĩa mạng và SQL server này bị mất. Những lúc như vậy Excel cứ đơ khoảng 30s rồi...

www.giaiphapexcel.com

 

[Nhattanktnn]

Bạn phải tách dường dẫn để lấy IP hoặc tên máy kết nối tới sau đó dùng Ping để xem nó có tắt/mở trước rồi mới kiểm tra tới file có tồn tại hay không.

Cảm ơn bác đã hướng dẫn rất nhiều, tính để tìm code Ping thì bạn @Ngày mai trời lại sáng đã gửi code phía dưới rồi

Bác tham khảo thêm:

Option Explicit
Function PingIP(ByVal IP As String) As Boolean
    Dim objWMIService, colItems, objItem
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_PingStatus Where timeout = 1000 and Address='" & IP & "'")
    For Each objItem In colItems
        If objItem.StatusCode = 0 Then
            PingIP = True
        Else
            PingIP = False
        End If
    Next objItem
End Function

Sub testPingIP()
    Dim bl As Boolean
    Const SeverName As String = "192.168.252.99"
    bl = PingIP(SeverName)
    If bl = True Then
        'lam gi do
    End If
End Sub

Cảm ơn bạn rất nhiều, mình test ping chạy rất tốt.
Lần nữa cảm ơn bác @ongke và bạn @Ngày mai trời lại sáng rất nhiều

Bài đã được tự động gộp: 21/6/22

Thử cái này (bài #2) xem nhanh hơn không?

Kiểm tra kết nối ổ đĩa mạng bằng VBA

Em đang dùng ADO để lấy dữ liệu 1 từ file .csv trên ổ đĩa mạng (Ví dụ: \\192.168.1.110\TaiLieu\abc.csv) và đẩy vào SQL server database (VD: IP của server Database 192.168.2.220) Có rất nhiều lý do mà kết nối đến ổ đĩa mạng và SQL server này bị mất. Những lúc như vậy Excel cứ đơ khoảng 30s rồi...

www.giaiphapexcel.com

Vâng, tốc độ ping rất nhanh anh ạ! Lâu lâu đăng bài mà được mọi người giúp đỡ thấy vui ghê!
Cảm ơn anh @befaint nhé!

 

[befaint]

Lâu lâu đăng bài mà được mọi người giúp đỡ thấy vui ghê!

Cái tội không tìm trước khi đăng bài đây mà.

 

[Nhattanktnn]

Cái tội không tìm trước khi đăng bài đây mà.

Em thề với anh là em tìm rồi, nhưng em tìm cái gì mà "kiểm tra file tồn tại mạng Lan", rồi "file exists" gì đó các kiểu mà nó ra không đúng cái mình cần. Với lại em cũng chưa gặp mấy bài kiểu này nên không chắc là trên này có bài nào về nó không nữa ấy
À có vấn đề là em thấy bài #2 và #3 đều là giải pháp nhưng em bấm chọn bài anh xong rồi thì không chọn được bài #2 .