Блог

У меня возникают проблемы с производительностью, когда пользователи выбирают сетевой диск в качестве места для сохранения файла, создаваемого моим макрокомандой.

Чтобы повысить эффективность, я подумываю о том, чтобы определить, является ли местоположение локальным или сетевым, и если оно находится в сети, я получу свой макрос, чтобы сохранить сгенерированный файл во временную папку и просто переместить его после его создания.

Используя VBA, как бы вы определили, является ли путь M:Folder Name локальной папкой (быстро управляемой) или находится в сети (требуется много времени для обработки запросов через VPN)?

Вы можете использовать функцию API GetDriveTypeA — см. https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-getdrivetypea

Поместите следующий код в модуль. Вы можете использовать функцию getDriveType для получения строки, описывающей тип диска, или использовать функцию isNetworkDrive , чтобы просто проверить, указывает ли буква диска на сетевой диск.

Вы можете передать полное имя папки или файла в качестве параметра, процедуры принимают только первый символ и добавляют : . Например, просто назовите это так:

 If isNetworkDrive("M:Folder Name") Then
    MsgBox "This is a network drive"
End If
  

Если вы хотите сделать его более сложным, сначала проверьте, является ли параметр UNC-путем (начиная с \ )

 Option Explicit

#If VBA7 Then
Declare PtrSafe Function apiGetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
#Else
Declare Function getDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
#End If

Function isNetworkDrive(path As String) As Boolean
    Dim driveType As Integer
    driveType = apiGetDriveType(getDrivePath(path))
    isNetworkDrive = (driveType = 4)
End Function

Function getDriveType(path As String) As String
    ' See https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-getdrivetypea
    Dim driveType As Integer
    driveType = apiGetDriveType(getDrivePath(path))
    
    If driveType = 0 Then
        getDriveType = ""               ' Drive unknown.
    ElseIf driveType = 1 Then
        getDriveType = "(undefined)"               ' No Root (not mounted?)
    ElseIf driveType = 2 Then
        getDriveType = "Removable"
    ElseIf driveType = 3 Then
        getDriveType = "Fixed"
    ElseIf driveType = 4 Then
        getDriveType = "Network"
    ElseIf driveType = 5 Then
        getDriveType = "CD-Rom"
    ElseIf driveType = 6 Then
        getDriveType = "Ram Disk"
    Else
        getDriveType = ""               ' Can never happen according to documentation
    End If
End Function

Function getDrivePath(ByVal path As String)
    GetDrivePath = UCase(Left(path, 1)) amp; ":"
End Function
  

Базовая функция https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-getdrivetypea GetDriveType .

Определяет, является ли дисковод съемным, фиксированным, CD-ROM, RAM-диском или сетевым диском.