Temat: Makro które sprawdza czy dany plik jest już otwarty

Witam

jak użyć "If" aby po włączeniu makra kod najpierw sprawdzał
czy plik "formatka do analiz 2.xls" jest już otwarty?? . Jeżeli będzie makro powinno w tym momencie kończyć swoją prace.

Sub KopiowanieBazyDanych()

Sheets("BAZA INFORMACJI").Select
ActiveSheet.Unprotect
Workbooks.Open Filename:="D:\Formatka do analiz 2.xls"
ChDir "D:\"
Workbooks.Open Filename:="D:\Formatka do analiz 2.xls"
Sheets("BAZA INFORMACJI").Select
Cells.Select
Selection.Copy
Workbooks("Formtka 2").Activate
Sheets("BAZA INFORMACJI").Select
'ActiveSheet.Unprotect
Cells.Select
ActiveSheet.Paste
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Workbooks("formatka do analiz 2.xls").Activate
Workbooks("formatka do analiz 2.xls").Close
Workbooks("Formtka 2").Activate
Sheets("MAGAZYN").Select
Range("B1").Select

Temat: Makro które sprawdza czy dany plik jest już otwarty

Sub CzyOtwarty ()



Dim wrbk As Workbook

Dim szukany As String



szukany = "formatka do analiz 2.xls"



For Each wrbk In Application.Workbooks

If wrbk.Name = szukany Then

Exit Sub

End If

Next



End Sub

Temat: Makro które sprawdza czy dany plik jest już otwarty

Witam,

Może nakreśle szerzej mój problem. Na dysku sieciowym mam plik
"Formatka do analiz 2.xls" oto scieżka:

"D:\Formatka do analiz 2.xls" i teraz chciałbym aby poniższe makro(1 post) po włączeniu wychodziło z dalszego kodu w przypadku gdy plik "Formatka do analiz 2.xls" jest już otwarty przez innego użytkownika czy jest to mozliwe??

Temat: Makro które sprawdza czy dany plik jest już otwarty

oprogramuj sobie błąd - będzie najprościej

Temat: Makro które sprawdza czy dany plik jest już otwarty

Function IsFileOpen(strFullPathFileName As String) As Boolean 

    ' na podstawie 

    ' http://www.xcelfiles.com 

    Dim hdlFile As Long 



    On Error Resume Next 

    hdlFile = FreeFile 

    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile 

        If Err.Number <> 0 Then IsFileOpen = True 

    Close hdlFile 

    On Error GoTo 0 

End Function

Temat: Makro które sprawdza czy dany plik jest już otwarty

błąd już oprogramowałem ale tylko w przypadku gdy użytkownik kliknie "nie" na poniższym pasku komunikatu. Chciałbym aby użytkownik nie miał opcji aby klinąć "tak" co powoduje ponowne otwrcie pliku gdy inny użytkownik go używa.





makro które mam teraz:

Sub moj()

On Error GoTo Handler

Sheets("BAZA INFORMACJI").Select


ActiveSheet.Unprotect
'otwieranie pliku z bazą danych
ChDir "D:\"
Workbooks.Open Filename:="D:\Formatka do analiz 2.xls"
Sheets("BAZA INFORMACJI").Select
Cells.Select
Selection.Copy
'kopiowananie do mojego pliku danych
Workbooks("Formtka 2").Activate
Sheets("BAZA INFORMACJI").Select
'ActiveSheet.Unprotect
Cells.Select
ActiveSheet.Paste
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Workbooks("formatka do analiz 2.xls").Activate
Workbooks("formatka do analiz 2.xls").Close
Workbooks("Formtka 2").Activate
Sheets("MAGAZYN").Select
Range("B1").Select
MsgBox ("Zakończono pomyślnie pobieranie danych")
Exit Sub
Handler:
MsgBox ("Błąd spróbuj ponownie za chwilę przeprowadzić import danych")

End Sub

Temat: Makro które sprawdza czy dany plik jest już otwarty

Zbigniew Budziewicz:

Function IsFileOpen(strFullPathFileName As String) As Boolean 

    ' na podstawie 

    ' http://www.xcelfiles.com 

    Dim hdlFile As Long 



    On Error Resume Next 

    hdlFile = FreeFile 

    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile 

        If Err.Number <> 0 Then IsFileOpen = True 

    Close hdlFile 

    On Error GoTo 0 

End Function

Panie Zbyszku a jak tą funkcje wkomponować w moje makro aby to działało??
Mój pozoiom rozumienia języka VBA się poprawia ale nie wiem za bardzo jak użyć tej funkcji w moim makrze:(

Pozdrawiam

Kod makra:

Sub moj()

On Error GoTo Handler

Sheets("BAZA INFORMACJI").Select

ActiveSheet.Unprotect
'otwieranie pliku z bazą danych
ChDir "D:\"
Workbooks.Open Filename:="D:\Formatka do analiz 2.xls"
Sheets("BAZA INFORMACJI").Select
Cells.Select
Selection.Copy
'kopiowananie do mojego pliku danych
Workbooks("Formtka 2").Activate
Sheets("BAZA INFORMACJI").Select
'ActiveSheet.Unprotect
Cells.Select
ActiveSheet.Paste
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Workbooks("formatka do analiz 2.xls").Activate
Workbooks("formatka do analiz 2.xls").Close
Workbooks("Formtka 2").Activate
Sheets("MAGAZYN").Select
Range("B1").Select
MsgBox ("Zakończono pomyślnie pobieranie danych")
Exit Sub
Handler:
MsgBox ("Błąd spróbuj ponownie za chwilę przeprowadzić import danych")

End Sub

Temat: Makro które sprawdza czy dany plik jest już otwarty

Sub moj()



Dim Wkb        As Workbook

Const plik     As String = "D:\Formatka do analiz 2.xls"



    With ThisWorkbook.Sheets("BAZA INFORMACJI")



        .Unprotect



        'czy istnieje plik

        If Dir(plik) <> "" Then



            'jeżeli tak, to czy otwarty

            If Not IsFileOpen(plik) Then



                'otwieranie pliku z bazą danych

                Set Wkb = Workbooks.Open(Filename:=plik)



                Wkb.Sheets("BAZA INFORMACJI").Cells.Copy .Range("A1")





                .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True



                Wkb.Close False



                ThisWorkbook.Sheets("MAGAZYN").Activate

                Range("B1").Activate



                MsgBox ("Zakończono pomyślnie pobieranie danych")



            Else

                MsgBox "Plik już jest otwarty"

            End If



        Else

            MsgBox "Plik nie istnieje"

        End If



    End With



    Set Wkb = Nothing



End Sub





Function IsFileOpen(strFullPathFileName As String) As Boolean

' na podstawie

' http://www.xcelfiles.com

Dim hdlFile    As Long



    On Error Resume Next

    hdlFile = FreeFile

    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile

    If Err.Number <> 0 Then IsFileOpen = True

    Close hdlFile

    On Error GoTo 0

End Function

UŻYWAJ ZNACZNIKÓW code BO MAŁO CZYTELNE STAJĄ SIĘ POSTY !!!

Temat: Makro które sprawdza czy dany plik jest już otwarty

Witam,

Odświeżę jeszcze stary temat,

funkcja sprawdzania czy plik jest otwarty przez innego użytkownika zaprezentowana przez Pana Zbyszka fajnie się u mnie sprawdza. Mam tylko jedno pytanie czy wie ktoś może jak dodatkowo sprawdzić nazwę użytkownika który ma otwarty plik aby później wyświetlić ją MsgBox???

Pozdrawiam

Temat: Makro które sprawdza czy dany plik jest już otwarty

Sub moj()



    Dim Wkb    As Workbook

    Const plik As String = "D:\Formatka do analiz 2.xls"



    With ThisWorkbook.Sheets("BAZA INFORMACJI")



        .Unprotect



        'czy istnieje plik

        If Dir(plik) <> "" Then



            'jeżeli tak, to czy otwarty

            If Not IsFileOpen(plik) Then



                'otwieranie pliku z bazą danych

                Set Wkb = Workbooks.Open(Filename:=plik)



                Wkb.Sheets("BAZA INFORMACJI").Cells.Copy .Range("A1")





                .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True



                Wkb.Close False



                ThisWorkbook.Sheets("MAGAZYN").Activate

                Range("B1").Activate



                MsgBox ("Zakończono pomyślnie pobieranie danych")



            Else

                MsgBox "Plik już jest otwarty przez " & LastUser(plik)

            End If



        Else

            MsgBox "Plik nie istnieje"

        End If



    End With



    Set Wkb = Nothing



End Sub





Function IsFileOpen(strFullPathFileName As String) As Boolean

    ' na podstawie

    ' http://www.xcelfiles.com

    Dim hdlFile As Long



    On Error Resume Next

    hdlFile = FreeFile

    Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile

    If Err.Number <> 0 Then IsFileOpen = True

    Close hdlFile

    On Error GoTo 0

End Function





Private Function LastUser(strPath As String) As String



    Dim strXl  As String

    Dim strFlag1 As String, strflag2 As String

    Dim i As Integer, j As Integer

    Dim hdlFile As Long

    Dim lNameLen As Byte





    strFlag1 = Chr(0) & Chr(0)

    strflag2 = Chr(32) & Chr(32)



    hdlFile = FreeFile

    Open strPath For Binary As hdlFile

    strXl = Space(LOF(hdlFile))

    Get 1, , strXl

    Close hdlFile



    j = InStr(1, strXl, strflag2)



    i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)



    lNameLen = Asc(Mid(strXl, i - 3, 1))

    LastUser = Mid(strXl, i, lNameLen)



End Function

Zbigniew Budziewicz edytował(a) ten post dnia 19.02.12 o godzinie 17:07

Temat: Makro które sprawdza czy dany plik jest już otwarty

Niestety coś mi nie działa gdy ja mam "plik" otwarty nie wyświetla się w MsgBox żadna nazwa użytkownika. Nie wiem czy to ma znaczenia ale jedynie co mi przychodzi do głowy to, że

Const plik As String = "D:\BAZA DANYCH.xlsm" jest w formacie excela 2010

Czy to może być przyczyną ???

Temat: Makro które sprawdza czy dany plik jest już otwarty

Więc trochę inne podejście do problemu:

W skoroszycie który ma być kontrolowany (w tym przykładzie Formatka do analiz 2.xls) takie kody:

Sub Auto_Open()



    Dim FF     As Integer

    Dim plik   As String

    Dim UserName As String, CompName As String



    plik = ThisWorkbook.Path & "\" & "owner.txt"

    FF = FreeFile



    If Not ThisWorkbook.ReadOnly Then

        UserName = Environ("UserName")

        CompName = Environ("ComputerName")

        Open plik For Output As #FF

        Write #FF, CompName, UserName

        Close #FF

    End If



End Sub









Sub Auto_Close()



    On Error Resume Next



    If Not ThisWorkbook.ReadOnly Then

        Kill ThisWorkbook.Path & "\" & "owner.txt"

    End If

    

    On Error GoTo 0



End Sub

W skoroszycie w którym sprawdzamy czy plik otwarty:

Sub moj()



    Dim Wkb    As Workbook

    Const plik As String = "D:\Formatka do analiz 2.xls"

    Const Sciezka As String = "D:\"





    With ThisWorkbook.Sheets("BAZA INFORMACJI")



        .Unprotect



        'czy istnieje plik

        If Dir(plik) <> "" Then



            'jeżeli tak, to czy otwarty

            If Not CzyOtwarty(Sciezka & "owner.txt") Then



                'otwieranie pliku z bazą danych

                Set Wkb = Application.Workbooks.Open(Filename:=plik)



                Wkb.Sheets("BAZA INFORMACJI").Cells.Copy .Range("A1")





                .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True



                Wkb.Close False



                ThisWorkbook.Sheets("MAGAZYN").Activate

                Range("B1").Activate



                MsgBox ("Zakończono pomyślnie pobieranie danych")



            End If



        Else

            MsgBox "Plik nie istnieje"

        End If



    End With



    Set Wkb = Nothing



End Sub







Function CzyOtwarty(plik As String) As Boolean



    Dim FF     As Integer

    Dim UserName As String, CompName As String



    If Not Dir(plik) = "" Then

        FF = FreeFile

        Open plik For Input As #FF

        Input #FF, CompName, UserName

        Close #FF

        MsgBox "Plik jest używany przez" & vbNewLine & _

               " użytkownika: " & UserName & vbNewLine & _

               " na stacji: " & CompName

        CzyOtwarty = True

    End If

    

End Function

Pomysł "zaginionego" (od co najmniej roku) Tajana.

Temat: Makro które sprawdza czy dany plik jest już otwarty

i tak powolutku można z Excela zrobić serwer bazodanowy ;)

Temat: Makro które sprawdza czy dany plik jest już otwarty

Witam
Chciałbym odświeżyć temat. Jestem początkujący i pomimo powyższych przykładów nie wiem jak je dostosować do swojego kodu. Plik znajduje się na dysku sieciowym T:\test.xlsx.
Wcześniej miałem sprawdzanie czy "ja" używający aplikacji mam otwarty plik, ale w przypadku kilku użytkowników w sieci jest to bezużyteczne.

   Dim check As Boolean, WB As Workbook





   For Each WB In Application.Workbooks



       If LCase(WB.Name) = "test.xlsx" Then



          check = True



       Exit For



    End If



  Next WB

  

  If check = True Then  ' Jeżeli jest otwarty ma się wyświetlić okno



    MsgBox "Skoroszyt " & vbNewLine & "text.xls jest już otwarty " & vbNewLine & "spróbuj jeszcze raz"



  Else     'Jeżeli jest zamknięty ma wykonać dalszą część programu