Написал программу для выбора файла, работает отлично. Но не могу заставить ее открывать нужную папку. Помогите кто чем может. Заранее спасибо.
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 ChDirUNC(ByVal sPath As String)
Dim lReturn As Long
lReturn = SetCurDir(sPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub