Как написать путь к файлу для двух человек, сопоставленных с различными дисками - PullRequest
0 голосов
/ 26 января 2019

Я пытаюсь написать код, который сохраняет резервную копию электронной таблицы Excel в одну общую папку, сопоставленную с двумя разными буквами, только при сохранении определенных пользователей.Это файл, к которому имеют доступ многие люди, поэтому я бы хотел сохранить резервную копию, только когда я или мой коллега в нем.

У меня есть папка, сопоставленная с диском G, у моего коллеги она есть на диске I.Как я могу написать путь к файлу для чтения обоих наших дисков?

TIA!

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Environ("Username") <> "agene" And Environ("Username") <> "aking" Then
        Exit Sub
    End If
    With ThisWorkbook
        .SaveCopyAs ("\Excel\Backup\Backup of " & .Name)
    End With
End Sub

1 Ответ

0 голосов
/ 26 января 2019

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

Public Function GetNetworkPath(ByVal driveName As String) As String
    '--- Converts a drive letter, e.g. 'W:\', to its fully qualified network
    '    path useful for saving a network folder location without any user-
    '    specific custom mapping
    '--- from https://www.mrexcel.com/forum/excel-questions/
    '            658830-show-full-file-paths-unc-not-mapped-drive-letters-print.html
    Dim networkObject  As Object
    Dim networkDrives As Object

    Set networkObject = CreateObject("WScript.Network")
    Set networkDrives = networkObject.enumnetworkdrives

    Dim i As Long
    GetNetworkPath = vbNullString
    For i = 0 To networkDrives.count - 1 Step 2
        If UCase$(networkDrives.item(i)) = UCase$(driveName) Then
            GetNetworkPath = networkDrives.item(i + 1)
            Exit For
        End If
    Next
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...