Prikazi cijelu temu 02.05.2012 08:30
miro35 Van mreze
Clan
Registrovan od:05.01.2009
Lokacija:-


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 11:30 od strane zxz.