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