Function ProvjeraP(BrojRac As String) As String

     Const PutTO = "C:\HCP\TO_FP"

    Const PutFrom = "C:\HCP\FROM_FP"

     

   

    Dim temp As String

    Dim ImeF(1 To 2) As String

    Dim ImeR(1 To 2) As String

    Dim fs, R, F

    Dim Brojac As Integer

    Dim i As Integer

    Dim Putanja_Filea As String

     

   

    ImeR(1) = "RCP_" & BrojRac & ".XML"  ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst

ImeR(2) = "RCP_" & BrojRac & ".ERR"

Provjera1:

Set fs = Application.FileSearch

With fs

    .LookIn = PutTO

    .FileType = 1

    If .Execute > 0 Then

        For i = 1 To .foundfiles.Count

         F = Right(.foundfiles(i), 3)

          If F = "XML" Then

          ImeF(1) = .foundfiles(i)

          ImeF(1) = ImeFajla(ImeF(1))

            If ImeF(1) = ImeR(1) Then

            DoEvents

            Brojac = Brojac + 1

               If Brojac > 3 Then GoTo Izlaz

               Zaustavi (Brojac)

               GoTo Provjera1

            End If

          End If

        Next i

    End If

 

End With

     

Provjera2:

Set fs = Application.FileSearch

With fs

    .LookIn = PutFrom

    .FileType = 1

    If .Execute > 0 Then

        For i = 1 To .foundfiles.Count

        F = Right(.foundfiles(i), 3)

            If F = "ERR" Then

            ImeF(2) = ImeFajla(.foundfiles(i))

                If ImeF(2) = ImeR(2) Then

                Putanja_Filea = .foundfiles(i)

                Close #1

                Open Putanja_Filea For Input As 1

                Input #1, temp

                Close #1

                MsgBox "GreÅ¡ka:" & temp & "!", vbExclamation, "Ra

un nije fiskaliziran"

               DoCmd.SetWarnings False

            DoCmd.RunSQL "UPDATE Proba SET Nefiskaliziran='" & "-1" & "' WHERE BrojRacuna='" & Forms.frmIZLAZMP.brojRacuna & "'"

DoCmd.SetWarnings True

                GoTo Kraj

                End If

            End If

        Next i

    End If

End With

     

Kraj:

 

    Exit Function

Izlaz:

    MsgBox "Ra

un nije ispisan,greška u komunikaciji sa ureajem!", vbExclamation, "Obavijest"

    DoCmd.SetWarnings False

            DoCmd.RunSQL "UPDATE Proba SET Nefiskaliziran='" & "-1" & "' WHERE BrojRacuna='" & Forms.frmIZLAZMP.brojRacuna & "'"

DoCmd.SetWarnings True

BrisiFile (PutTO)

 

GoTo Provjera2

    GoTo Kraj

    End Function

     

    Function ImeFajla(PutanjaF As String) As String

    '*******************************************

    'Ime:      ImeDir   (Function)

    'Sadržaj: Odvaja ime fajla od putanje

    'Autor:     ZXZ

    'Datum:      09 01, 2010, 11:36:53

    'Adresa: Tuzla BiH

    'Email:     zxz@icentar.ba

    'Ulazni parametri:Putanja

    'Izlazni parametri:Zadnj dir od putanja

    '*******************************************

       Dim X As Integer

        Dim Putanja As String

       

        On Error Resume Next

    Putanja = PutanjaF

Start:

    Do Until Right$(Putanja, 1) = "\"

            Putanja = Left$(Putanja, Len(Putanja) - 1)

     Loop

     ImeFajla = Mid(PutanjaF, Len(Putanja) + 1)

    End Function

    Function Zaustavi(Trajanje)

    Dim VRIJEME

     

    DoEvents

     

    Trajanje = Trajanje + Timer()

Start:

    VRIJEME = Timer()

    If VRIJEME < Trajanje Then GoTo Start

    End Function

    Function BrisiFile(Putanja As String)

    Dim fs

    Dim i As Integer

       

    Set fs = Application.FileSearch

    With fs

        .LookIn = Putanja

        .FileType = 1

        If .Execute > 0 Then

            For i = 1 To .foundfiles.Count

            Kill .foundfiles(i)

            Next i

        End If

    End With

    End Function