Prikazi cijelu temu 03.05.2012 13:04
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Application.FileSearch Access 2010
Evo.
Proceduru imeFilea mozes obrisati netreba ti vise.
Proceduru ProvjeraP i BrisiFile zamijeni sa ovim mojim procedurama.

PreuzmiIzvorni kôd (Visual Basic):
  1. Function ProvjeraP(BrojRac As String) As String
  2. Dim temp As String
  3. Dim ImeF(1 To 2) As String
  4. Dim ImeR(1 To 2) As String
  5. Dim Brojac As Integer
  6. Dim Putanja_Filea As String
  7.  
  8. Const PutTO = "C:\HCP\TO_FP"
  9. Const PutFrom = "C:\HCP\FROM_FP"
  10. ImeR(1) = "RCP_" & BrojRac & ".XML"  ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  11. ImeR(2) = "RCP_" & BrojRac & ".ERR"
  12.  
  13.  
  14. Provjera1:
  15. ImeF(1) = Dir(PutTO & "\" & ImeR(1))
  16. If ImeF(1) = ImeR(1) Then
  17. DoEvents
  18. Brojac = Brojac + 1
  19. If Brojac > 3 Then GoTo IZLAZ
  20.    Zaustavi (Brojac)
  21.    GoTo Provjera1
  22. End If
  23.  
  24. Provjera2:
  25. ImeF(2) = Dir(PutFrom & "\" & ImeR(2))
  26. If ImeF(2) = ImeR(2) Then
  27. Putanja_Filea = PutFrom & "\" & ImeF(2)
  28. Close #1
  29. Open Putanja_Filea For Input As 1
  30. Input #1, temp
  31. Close #1
  32. MsgBox "Greška:" & temp & "!", vbExclamation, "Raun nije fiskaliziran"
  33. DoCmd.SetWarnings False
  34. DoCmd.RunSQL "UPDATE GLSTAVKEMP1 SET Nefiskaliziran='" & "-1" & "' WHERE BROULIZ='" & Forms.frmIZLAZMP.BROIZD & "'"
  35. DoCmd.SetWarnings True
  36. GoTo Kraj
  37. End If
  38.    
  39. Kraj:
  40.     Exit Function
  41. IZLAZ:
  42.     MsgBox "Ra
  43. un nije ispisan,greška u komunikaciji sa ureajem!", vbExclamation, "Obavijest"
  44.     DoCmd.SetWarnings False
  45.             DoCmd.RunSQL "UPDATE GLSTAVKEMP1 SET Nefiskaliziran='" & "-1" & "' WHERE BROULIZ='" & Forms.frmIZLAZMP.BROIZD & "'"
  46. DoCmd.SetWarnings True
  47. BrisiFile (PutTO)
  48. GoTo Provjera2
  49.     GoTo Kraj
  50.     End Function
  51. Function BrisiFile(Putanja As String)
  52. Dim ImeF As String
  53.    
  54.        
  55.  Putanja = Putanja & "\"
  56.  ImeF = Dir(Putanja, vbDirectory)
  57.  Do While ImeF <> ""
  58.  
  59.  ImeF = Dir
  60.  If ImeF <> "." And ImeF <> ".." And ImeF <> "" Then
  61.  Kill Putanja & "\" & ImeF
  62.  End If
  63.  Loop
  64.        
  65. End Function
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.