Bosna i Hercegovina



#1 02.05.2012-07:30
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Application.FileSearch Access 2010
Imam ovu funkciju za provjeru da li je račun izašao na fiskalni printer:
DownloadIzvorni kod (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 komentar je mijenjan 3 puta. zadnja izmjena 02.05.2012-10:30 od strane zxz. ↑  ↓

#2 02.05.2012-10:05
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,416


Subject: 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.
Pozdrav
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 02.05.2012-10:30 od strane zxz. ↑  ↓

#3 02.05.2012-11:15
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


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

Prilozi:
Informacije o fajlu: rar  clFileSearch.rar
Preuzimanja: 23
Veličina: 6.25 KB

↑  ↓

#4 02.05.2012-11:35
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,416


Subject: Re: Application.FileSearch Access 2010
Roko:
Ova ti je klasa dobra i mogla bi se postaviti u arhivu ali za njega treba prostije rjesenje:
DownloadIzvorni kod (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

Pozdrav
↑  ↓

#5 03.05.2012-07:03
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Re: Application.FileSearch Access 2010
Evo ostatak funkcija:
DownloadIzvorni kod (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 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: 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 Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,416


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

DownloadIzvorni kod (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

Pozdrav
↑  ↓

#8 03.05.2012-12:30
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: 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 Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,416


Subject: Re: Application.FileSearch Access 2010
Ova naredba dir je iz vba tako da radi u svim verzijama.
Pozdrav
↑  ↓

Stranice (1): 1


All times are GMT +01:00. Current time: 21.09.2017-18:33.