Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Проверка, открыт/используется ли файл Excel? / 6 сообщений из 6, страница 1 из 1
11.01.2005, 16:32
    #32859642
GliderAlex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверка, открыт/используется ли файл Excel?
Есть событие на нажатие кнопки - экспорт строк из подчинённой формы в файл Excel
Помогите пожалуйста! Необходимо добавить проверку на то что файл используется или открыт и если да то выдать сообщение о этом и прервать операцию.

Вот само событие

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
Private Sub Êíîïêà22_Click()
Dim myOlApp As Object
Dim MyWo As Excel.Workbook
Dim mysheet As Excel.Worksheet
Dim MyCel As Variant
Dim MyRst As ADODB.Recordset
Dim I As Long
Dim Y As Long

Set myOlApp = CreateObject("excel.Application")
Set MyWo = myOlApp.Workbooks.Open("c:\abuser1.xls")
Set mysheet = MyWo.Worksheets("Ëèñò1")
Set rs = Me.f_p_ID_Length.Form.Recordset
     
I =  1 
Do While Len(mysheet.Cells(I,  1 )) <>  0 
I = I +  1 
Loop

          
rs.MoveFirst
Do Until rs.EOF
With rs

     
     mysheet.Cells(I,  3 ).Formula = .Fields("Lot")
     'Cells(3, 3).Select
     'Selection.Interior.ColorIndex = 4
     mysheet.Cells(I,  2 ).Formula = .Fields("ID_Number")
     mysheet.Cells(I,  1 ).Formula = .Fields("Date")

I = I +  1 
rs.MoveNext
End With
Loop


MyWo.Save
Set mysheet = Nothing
MyWo.Close
Set MyWo = Nothing
End Sub


...
Рейтинг: 0 / 0
15.01.2005, 22:59
    #32866542
МаксимВ
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверка, открыт/используется ли файл Excel?
Пример не мой, не проверял:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Private Sub Command1_Click() 
  MsgBox IsWorkBookOpen("c:\abuser1.xls") 
End Sub 

Public Function IsWorkBookOpen(wbPath As String) As Boolean 
' 
On Error Resume Next 

Open wbPath For Input Lock Read As # 1  
Close # 1  
IsWorkBookOpen = Err.Number <>  0  

End Function 
...
Рейтинг: 0 / 0
17.01.2005, 11:04
    #32867267
Processor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверка, открыт/используется ли файл Excel?
В вышеприведенном примере оператор
Код: plaintext
Open wbPath For Input Lock Read As # 1 
должен открыть файл для чтения , а затем заблокировать его.
Более строгая проверка на занятость файла производится ОС при открытии файла на запись (добавление),
при этом Lock подразумевается по умолчанию:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Public Function IsFileInUse(ByRef txtFullPath As String) As Boolean
IsFileInUse = False
If Len(Dir(txtFullPath)) =  0  Then Exit Function 'файла нет, нет и его занятости.
Dim dteEnd As Date
dteEnd = DateAdd("s",  10 , Now())        'задаем интервал ожидания в 10 с
Dim fso As New FileSystemObject, testFile As Scripting.TextStream

On Error GoTo ErrHandler                'оператор действует в рамках ВСЕЙ функции,
                                        'здесь он - для акцента на операции Open File
'Следующий оператор должен генерировать ошибку, если файл занят:
Set testFile = fso.OpenTextFile(Filename:=txtFullPath, IOMode:=ForAppending, Create:=False)
'сюда попадаем, если ошибки нет, следовательно, файл свободен ForAppending.
'но Appending будет не здесь, здесь- просто проверка, что такая операция возможна, поэтому:
DoEvents
testFile.Close
Exit Function
'Сюда попадаем, если файл ещё не освобождён предыдущей операцией:
'операция продолжается под управлением ОС, а программа об этом не подозревает!
ErrHandler:
Dim lngErrCode As Long, strErrDscr As String
lngErrCode = Err.Number
strErrDscr = Err.Description
Err.Clear
If dteEnd > Now() Then
    Sleep  100            'Спи, моя радость, усни... на 100 миллисекунд
    Resume              'execution resumes with the statement that caused the error.
Else
    MsgBox txtFullPath & vbCrLf & _
        "Ошибка открытия файла для добавления записей." & vbCrLf & _
        "Код ошибки:" & lngErrCode & vbCrLf & _
        strErrDscr, vbInformation + vbOKOnly, "Функция IsFileInUse..."
End If
IsFileInUse = True
End Function
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
30.05.2008, 18:33
    #35346534
Sergey_su
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверка, открыт/используется ли файл Excel?
Спасибо за примеры.
Но у меня возникла необходимость, показать кем открыт файл.
Т.е. по сетке файл открыл другой пользователь и необходимо указать его имя или комп. Помогите.
А потом по возможности закрыть у него файл, правда мало вероятно это, ну или отправить сообщение, мол закрывай файлик.
...
Рейтинг: 0 / 0
30.05.2008, 18:53
    #35346589
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверка, открыт/используется ли файл Excel?
Как идея:

В модуле книги:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
Option Explicit

Private Declare Function GetUserName Lib "advapi32.dll" Alias _
                                    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function GetNetworkID() As String

    Dim strUserName As String

    strUserName = String$( 100 , Chr$( 0 ))
    GetUserName strUserName,  100 
    GetNetworkID = Left$(strUserName, InStr(strUserName, Chr$( 0 )) -  1 )
    
End Function

В книге:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Option Explicit

Private Sub Workbook_Open()
    LogUser
End Sub

Private Sub LogUser()

Dim fs As Object
Dim a As Object

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\LogFile.txt", True)

a.WriteLine (GetNetworkID & ", " & CStr(Now))
a.Close
       
End Sub
...
Рейтинг: 0 / 0
30.05.2008, 19:05
    #35346611
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проверка, открыт/используется ли файл Excel?
Для информации:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
    Dim i As Integer
    
    For i =  1  To  36 
        Debug.Print i & ", " & GetUser(i)
    Next i

Public Function GetUser(ByVal pint As Integer) As String
    GetUser = UCase$(Environ$(pint))
End Function
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Проверка, открыт/используется ли файл Excel? / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]