Проверка наличия файла  
 
Function FileExists(iFileName As String) As Boolean  
' Возвращает ИСТИНА, если файл существует  
   FileExists = CreateObject("Scripting.FileSystemObject").FileExists(iFileName)  
 ' FileExists = (Dir(fname) <> "") - вариант работает некорректно  
End Function    
 
Проверка сетевого пути  
Function UNC(ByVal NetworkPath$) As String  
   On Error Resume Next  
   With CreateObject("Scripting.FileSystemObject").getfolder(NetworkPath$)  
        If .Drive.ShareName <> "" Then  
           UNC = Replace(.path, .Drive.path, .Drive.ShareName) & "\"  
        Else  
           UNC = NetworkPath$  
        End If  
   End With  
End Function  
 
Проверка истинности пути к файлу  
 
Function PathExists(pname) As Boolean  
' Возвращает ИСТИНА, если путь существует  
Dim X As String  
On Error Resume Next  
X = GetAttr(pname) And 0  
If Err = 0 Then PathExists = True _  
Else PathExists = False  
End Function

{quote}{login=VovaK}{date=02.09.2011 11:19}{thema=}{post}Проверка наличия файла  
 
Function FileExists(iFileName As String) As Boolean  
' Возвращает ИСТИНА, если файл существует  
   FileExists = CreateObject("Scripting.FileSystemObject").FileExists(iFileName)  
 ' FileExists = (Dir(fname) <> "") - вариант работает некорректно  
End Function    
 
Проверка сетевого пути  
Function UNC(ByVal NetworkPath$) As String  
   On Error Resume Next  
   With CreateObject("Scripting.FileSystemObject").getfolder(NetworkPath$)  
        If .Drive.ShareName <> "" Then  
           UNC = Replace(.path, .Drive.path, .Drive.ShareName) & "\"  
        Else  
           UNC = NetworkPath$  
        End If  
   End With  
End Function  
 
Проверка истинности пути к файлу  
 
Function PathExists(pname) As Boolean  
' Возвращает ИСТИНА, если путь существует  
Dim X As String  
On Error Resume Next  
X = GetAttr(pname) And 0  
If Err = 0 Then PathExists = True _  
Else PathExists = False  
End Function{/post}{/quote}  
 
Спасибо, пригодится)

{quote}{login=VovaK}{date=02.09.2011 11:30}{thema=}{post}Проверьте как работает фрагмент процедуры, думаю Вам понравится:  
 
Sub CopyDoc()  
Dim a As Variant, MainBook As Workbook, CurrentSheet As String  
 Set MainBook = ActiveWorkbook  
 CurrentSheet = ActiveSheet.Name  
 a = MsgBox("Копируемая файл уже открыт?", Buttons:=vbYesNo + vbQuestion + vbDefaultButton1)  
    Select Case a  
           Case Is = vbNo  
              Dim FD As FileDialog  
              Dim iFileName As String  
              Dim Book As Workbook  
              Dim CheckNameBook As String  
     
              Set FD = Application.FileDialog(msoFileDialogFilePicker)  
       With FD  
             .Filters.Clear  
             .Filters.Add "Microsoft Excel files", "*.xls"  
             .Filters.Add "All files", "*.*"  
             .AllowMultiSelect = False  
             .InitialFileName = ThisWorkbook.path  
             .Title = "Открытие документа"  
             .ButtonName = "Открыть"  
            If .Show = False Then  
               MsgBox "Вы не указали файл - источник!", 48, "Ошибка"  
               Exit Sub  
            Else  
               iFileName = .SelectedItems(1)  
            End If  
         End With  
         Set FD = Nothing  
         CheckNameBook = GetWorkbookName(iFileName)  
          'Проверка - открыт ли выбранный файл  
         If IsWorkbookOpen(CheckNameBook) = False Then  
           Set Book = Workbooks.Open(Filename:=iFileName, UpdateLinks:=False)  
         Else  
         a = MsgBox("Файл с именем `" & CheckNameBook & "` уже открыт. Продолжить?", Buttons:=vbYesNo + vbQuestion + vbDefaultButton1)  
           Select Case a  
             Case Is = vbNo  
              MsgBox "Копирование прервано пользователем", 48, "Ошибка"  
              Call TurnOnScreen: Exit Sub  
             Case Is = vbYes  
              Set Book = Workbooks(CheckNameBook)  
           End Select  
          End If  
       Case Is = vbYes  
           ChoiseBook.Show  
              If SelectName <> "" Then  
                Set Book = Workbooks(SelectName)  
              Else  
                MsgBox "Вы не выбрали имя книги!", 48, "Ошибка"  
                Exit Sub  
              End If  
     End Select  
 MainBook.Activate  
 Worksheets(CurrentSheet).Activate  
' ....... далее по Вашему сценарию  
End Sub  
 
Function IsWorkbookOpen(wbName As String) As Boolean  
' Returns TRUE if the workbook is already opened  
On Error Resume Next  
With Workbooks(wbName): End With  
IsWorkbookOpen = (Err = 0)  
End Function  
 
Форму ChoiseBook.Show смотри здесь http://www.excelworld.ru/forum/3-596-1{/post}{/quote}  
 
Тут, наверно, рассмотрены все варианты :)