Centar za edukaciju-BiH

iCentar → Racunari i oprema → Programirannje i baze podataka → Access


Prosiri i skupi Opcije teme
Stranice (1):1
 Prikazi prvu neprocitanu poruku

#1 02.05.2012 07:30
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Application.FileSearch Access 2010
Imam ovu funkciju za provjeru da li je račun izaÅ¡ao na fiskalni printer:
PreuzmiIzvorni kôd (Text):
  1. Function ProvjeraP(BrojRac As String) As String
  2.     Const PutTO = "C:\HCP\TO_FP"
  3.     Const PutFrom = "C:\HCP\FROM_FP"
  4.      
  5.    
  6.     Dim temp As String
  7.     Dim ImeF(1 To 2) As String
  8.     Dim ImeR(1 To 2) As String
  9.     Dim fs, R, F
  10.     Dim Brojac As Integer
  11.     Dim I As Integer
  12.     Dim Putanja_Filea As String
  13.        'BrojRac = "Footer.xml"
  14.     'BrojRac = " & Me.BROIZD & " ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  15.     ImeR(1) = "RCP_" & BrojRac & ".XML"  ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  16. ImeR(2) = "RCP_" & BrojRac & ".ERR"
  17. Provjera1:
  18. Set fs = Application.FileSearch
  19. With fs
  20.     .LookIn = PutTO
  21.     .FileType = 1
  22.     If .Execute > 0 Then
  23.         For I = 1 To .foundfiles.Count
  24.          F = Right(.foundfiles(I), 3)
  25.           If F = "XML" Then
  26.           ImeF(1) = .foundfiles(I)
  27.           ImeF(1) = ImeFajla(ImeF(1))
  28.             If ImeF(1) = ImeR(1) Then
  29.             DoEvents
  30.             Brojac = Brojac + 1
  31.                If Brojac > 3 Then GoTo IZLAZ
  32.                Zaustavi (Brojac)
  33.                GoTo Provjera1
  34.             End If
  35.           End If
  36.         Next I
  37.     End If
  38.  
  39. End With
  40.      
  41. Provjera2:
  42. Set fs = Application.FileSearch
  43. With fs
  44.     .LookIn = PutFrom
  45.     .FileType = 1
  46.     If .Execute > 0 Then
  47.         For I = 1 To .foundfiles.Count
  48.         F = Right(.foundfiles(I), 3)
  49.             If F = "ERR" Then
  50.             ImeF(2) = ImeFajla(.foundfiles(I))
  51.                 If ImeF(2) = ImeR(2) Then
  52.                 Putanja_Filea = .foundfiles(I)
  53.                 Close #1
  54.                 Open Putanja_Filea For Input As 1
  55.                 Input #1, temp
  56.                 Close #1
  57.                 MsgBox "GreÅ¡ka:" & temp & "!", vbExclamation, "Ra
  58. un nije fiskaliziran"
  59.                 DoCmd.SetWarnings False
  60.             DoCmd.RunSQL "UPDATE GLSTAVKEMP1 SET Nefiskaliziran='" & "-1" & "' WHERE BROULIZ='" & Forms.frmIZLAZMP.BROIZD & "'"
  61.                DoCmd.SetWarnings True
  62.                 GoTo Kraj
  63.                 End If
  64.             End If
  65.         Next I
  66.     End If
  67. End With
  68.      
  69. Kraj:
  70.  
  71.     Exit Function
  72. IZLAZ:
  73.     MsgBox "Ra
  74. un nije ispisan,greška u komunikaciji sa ureajem!", vbExclamation, "Obavijest"
  75.     DoCmd.SetWarnings False
  76.             DoCmd.RunSQL "UPDATE GLSTAVKEMP1 SET Nefiskaliziran='" & "-1" & "' WHERE BROULIZ='" & Forms.frmIZLAZMP.BROIZD & "'"
  77. DoCmd.SetWarnings True
  78. BrisiFile (PutTO)
  79. 'Kill "C:\HCP\TO_FP\Footer.xml"
  80. 'Kill "C:\HCP\TO_FP\RCP_" & Me.BROIZD & ".XML"
  81. 'Kill "C:\HCP\TO_FP\CMD.OK"
  82. GoTo Provjera2
  83.     GoTo Kraj
  84.     End Function
U Access-u 2010 ovo "Set fs = Application.FileSearch" ne postoji.Našao sam link na microsoft-ovim stranicama ali neznam kako to napraviti.Evo link:
Link
Miro
Ovaj post je ureden 3 puta. Posljednja izmjena 02.05.2012 10:30 od strane zxz. ↑  ↓

#2 02.05.2012 10:05
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,711


Predmet:Application.FileSearch-dir
Da filesearc ne postoji od neke verzije accessa. I ne sjecam se od koje.
Treba koristiti dir:
Primjer:
PutanjaOrg = ("C:\")
PutanjaS = "d:\temp\"
ImeOrginal = Dir(PutanjaOrg, vbDirectory)
Do While ImeOrginal <> ""
ImeOrginal = Dir

Loop

Htio sam prepraviti proceduru ali ne mogu dok mi ne das i ovu proceduru:
ImeFajla
a ovo pretpostavljam sluzi samo da saceka i ima procedura zaustavi.
If ImeF(1) = ImeR(1) Then
DoEvents
Brojac = Brojac + 1
If Brojac > 3 Then GoTo IZLAZ
Zaustavi (Brojac)
GoTo Provjera1

Ako se be sbadjes samo postavi i ovu proceduru pa cu prepraviti kod.
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
Ovaj post je ureden 1 puta. Posljednja izmjena 02.05.2012 10:30 od strane zxz. ↑  ↓

#3 02.05.2012 11:15
roko Van mreze
Clan
Registrovan od:02.02.2009
Postovi:236


Predmet:Re: Application.FileSearch Access 2010
možeš kroz ovu clasu

Prilozi:
Informacije o tipu datoteke za:rar  clFileSearch.rar
Preuzimanja:353
Velicina datoteke:6.25 KB

↑  ↓

#4 02.05.2012 11:35
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,711


Predmet:Re: Application.FileSearch Access 2010
Roko:
Ova ti je klasa dobra i mogla bi se postaviti u arhivu ali za njega treba prostije rjesenje:
PreuzmiIzvorni kôd (Visual Basic):
  1. Function ProvjeraP(BrojRac As String) As String
  2.     Const PutTO = "C:\HCP\TO_FP"
  3.     Const PutFrom = "C:\HCP\FROM_FP"
  4.      
  5.    
  6.     Dim temp As String
  7.     Dim ImeF(1 To 2) As String
  8.     Dim ImeR(1 To 2) As String
  9.     Dim fs, R, F
  10.     Dim Brojac As Integer
  11.     Dim I As Integer
  12.     Dim Putanja_Filea As String
  13.        'BrojRac = "Footer.xml"
  14.    'BrojRac = " & Me.BROIZD & " ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  15.    ImeR(1) = "\RCP_" & BrojRac & ".XML"  ' Broj rac iz polja me.Me.BROIZD + RCP_ tekst
  16.     ImeR(2) = "\RCP_" & BrojRac & ".ERR"
  17. ImeF(1) = Dir(ImeR(1))
  18. ImeF(2) = Dir(ImeR(2))
  19. Provjera1:
  20. If ImeF(1) = ImeR(1) Then
  21. DoEvents
  22. Brojac = Brojac + 1
  23.    If Brojac > 3 Then GoTo IZLAZ
  24.    Zaustavi (Brojac)
  25.    GoTo Provjera1
  26. End If
  27.  
  28. Provjera2:
  29.     If ImeF(2) = ImeR(2) Then
  30.     Putanja_Filea = .foundfiles(I)
  31.     Close #1
  32.     Open Putanja_Filea For Input As 1
  33.     Input #1, temp
  34.     Close #1
  35.     MsgBox "GreÅ¡ka:" & temp & "!", vbExclamation, "Raun nije fiskaliziran"
  36.     DoCmd.SetWarnings False
  37.     DoCmd.RunSQL "UPDATE GLSTAVKEMP1 SET Nefiskaliziran='" & "-1" & "' WHERE BROULIZ='" & Forms.frmIZLAZMP.BROIZD & "'"
  38.     DoCmd.SetWarnings True
  39.     GoTo Kraj
  40.     End If
  41.  
  42.      
  43. Kraj:
  44.  
  45.     Exit Function
  46. IZLAZ:
  47.     MsgBox "Ra
  48. un nije ispisan,greška u komunikaciji sa ureajem!", vbExclamation, "Obavijest"
  49.     DoCmd.SetWarnings False
  50.             DoCmd.RunSQL "UPDATE GLSTAVKEMP1 SET Nefiskaliziran='" & "-1" & "' WHERE BROULIZ='" & Forms.frmIZLAZMP.BROIZD & "'"
  51. DoCmd.SetWarnings True
  52. BrisiFile (PutTO)
  53. 'Kill "C:\HCP\TO_FP\Footer.xml"
  54. 'Kill "C:\HCP\TO_FP\RCP_" & Me.BROIZD & ".XML"
  55. 'Kill "C:\HCP\TO_FP\CMD.OK"
  56. GoTo Provjera2
  57.     GoTo Kraj
  58.     End Function
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#5 03.05.2012 07:03
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Application.FileSearch Access 2010
Evo ostatak funkcija:
PreuzmiIzvorni kôd (Text):
  1. Function ImeFajla(PutanjaF As String) As String
  2.     '*******************************************
  3.     'Ime:      ImeDir   (Function)
  4.     'Sadržaj: Odvaja ime fajla od putanje
  5.     'Autor:     ZXZ
  6.     'Datum:      09 01, 2010, 11:36:53
  7.     'Adresa: Tuzla BiH
  8.     'Email:     zxz@icentar.ba
  9.     'Ulazni parametri:Putanja
  10.     'Izlazni parametri:Zadnj dir od putanja
  11.     '*******************************************
  12.        Dim X As Integer
  13.         Dim Putanja As String
  14.        
  15.         On Error Resume Next
  16.     Putanja = PutanjaF
  17. Start:
  18.     Do Until Right$(Putanja, 1) = "\"
  19.             Putanja = Left$(Putanja, Len(Putanja) - 1)
  20.      Loop
  21.      ImeFajla = Mid(PutanjaF, Len(Putanja) + 1)
  22.     End Function
  23.     Function Zaustavi(Trajanje)
  24.     Dim VRIJEME
  25.      
  26.     DoEvents
  27.      
  28.     Trajanje = Trajanje + Timer()
  29. Start:
  30.     VRIJEME = Timer()
  31.     If VRIJEME < Trajanje Then GoTo Start
  32.     End Function
  33.     Function BrisiFile(Putanja As String)
  34.     Dim fs
  35.     Dim I As Integer
  36.        
  37.     Set fs = Application.FileSearch
  38.     With fs
  39.         .LookIn = Putanja
  40.         .FileType = 1
  41.         If .Execute > 0 Then
  42.             For I = 1 To .foundfiles.Count
  43.             Kill .foundfiles(I)
  44.             Next I
  45.         End If
  46.     End With
  47.     End Function
Miro
↑  ↓

#6 03.05.2012 07:17
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Application.FileSearch Access 2010
Evo ovde imam grešku kad sam probao ovu tvoju funkciju gore od zxz
Putanja_Filea = .foundfiles(I)
Miro
↑  ↓

#7 03.05.2012 12:04
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,711


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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

#8 03.05.2012 12:30
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Postovi:608


Predmet:Re: Application.FileSearch Access 2010
To je to hvala.
Ovo mi je trebalo jer kad pokrenem pod access2010 ne izvršava se ova funkcija bez obzira što je aplikacija u formatu 2003.
Miro
↑  ↓

#9 03.05.2012 13:55
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Postovi:10,711


Predmet:Re: Application.FileSearch Access 2010
Ova naredba dir je iz vba tako da radi u svim verzijama.
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.
↑  ↓

Stranice (1):1

Srodne teme

Ko je online?

Aktivni clanovi:
nema clanova


Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 12: 04 am.