MyTetra Share
Делитесь знаниями!
Ошибка оперетора ChDir в программе для выбора файла
12.01.2018
10:44
Текстовые метки: ChDir
Раздел: VBA - FSO

Написал программу для выбора файла, работает отлично. Но не могу заставить ее открывать нужную папку. Помогите кто чем может. Заранее спасибо.
sub searchfile()
ActWbk = ActiveWorkbook.Name
    ChDir Sheets("Set").Cells(13, 2).Value 'Эта команда не работает, что только не делал - открывает Мои документы
    While Msg <> 6
        If Application.FindFile = False Then Exit Sub
        OpenFileName = ActiveWorkbook.Name
        Msg = MsgBox("Этот файл подойдет?", vbYesNoCancel, "Выбор файла")
        If Msg = 2 Then
            ActiveWorkbook.Close
            Exit Sub
        End If
        If Msg = 7 Then ActiveWorkbook.Close
    Wend
end sub
В ячейке B13 сетевой адрес: \\192.168.0.200\s1\ЗАКАЗЫ\Заказы\Пробная\


Располагаю следющей информацией.
Свойства ChDrive, ChDir не умеют работать с сетевыми адресами в формате UNC. Они работают только с локальными адресами папок и с теми сетевыми адресами, в которых фигурируют буквы дисков, нпр. X:\...\...

Для работы с сетевыми папками можно:
а) создать соединение с нужной/корневой папкой в эксплорере (присвоить ему диск). Недостаток - на каждом комрьютере, на котором работает макрос, должно быть создано это соединение вручную.
б) Воспользоваться API функциями. Ниже приведен пример из учебника для этого случая. Вместо СhDir будет использоваться ChDirUNC - процедура из макроса.

' **************************************************************
' Declarations for the ChDirUNC example function
' **************************************************************
'Set the current directory to a UNC path
Private Declare Function SetCurDir Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: Change to a UNC Directory
'
' Arguments:    sPath       The path to change to.
'                           Can be either standard or UNC form:
'                           <Drive Letter>:\Path
'                           \\server\share\path
'
' Date          Developer       Action
' --------------------------------------------------------------
' 02 Jun 04     Stephen Bullen  Created
'
Sub test_ChDirUNC()

Dim strPath As String

strPath = "\\rudh002113\share_\_trash\MonitoringSkidReader\PEIN\2018\M01\2018-01-11"

strPath = "I:\_My_Site\0RU_DI\Tolerie\01_Echange_Departementsdgtyiguu\"

ChDirUNC strPath

End Sub


Sub ChDirUNC(ByVal sPath As String)

Dim lReturn As Long

lReturn = SetCurDir(sPath)

If lReturn = 0 Then

' Err.Description vbObjectError + 1, "Error setting path."

Debug.Print Err.Number

End If

End Sub

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования