- 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