Sub Fiskale(FL_ID As Integer)
On Error GoTo shuki
Dim rs As New ADODB.Recordset
rs.Open "SELECT SUBFATURA.FATURAS, SUBFATURA.mat, SUBFATURA.emri,SUBFATURA.SASIA, SUBFATURA.cmimig from SUBFATURA where (((SUBFATURA.FATURAS)=" & FATURAS & "));", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If rs.BOF = True And rs.EOF = True Then Exit Sub
Dim iFile As Integer
iFile = FreeFile()
Dim filepath As String
filepath = "C:\Temp\" + GetGUID + ".INP"
If Len(Dir(filepath)) > 0 Then
Kill (filepath)
End If
Open filepath For Binary Access Write As #iFile
Dim str As String, IDF As Integer
Do Until rs.EOF = True
str = "S,1,______,_,__;" & rs.Fields(2) & ";" & Format(rs.Fields(3), "0.##") _
& ";" & Format(rs.Fields(4), "0.###") & ";1;1;2;0;" & rs.Fields(1) & ";0;" + vbCrLf
Put #iFile, , str 'For example
IDF = rs.Fields(0)
rs.MoveNext
Loop
Put #iFile, , "Q,1,______,_,__;1;JU FALEMINDERIT" + vbCrLf
str = "Q,1,______,_,__;2; Ref Nr: " & IDF & vbCrLf
Put #iFile, , str
Put #iFile, , "T,1,______,_,__;0"
Close #iFile
Exit_Fiskale:
Exit Sub
shuki:
MsgBox Err.Description
Resume Exit_Fiskale
End Sub
Sub xRaporti()
Dim iFile As Integer
iFile = FreeFile()
Dim filepath As String
filepath = "C:\Temp\xRaportiNgaSM.INP"
If Len(Dir(filepath)) > 0 Then
Kill (filepath)
End If
Open filepath For Binary Access Write As #iFile
Dim str As String, IDF As Integer
str = "E,1,______,_,__;Printon X raportin;F-Link KS Enternet;" + vbCrLf
Put #iFile, , str 'For example
str = "R,1,______,_,__;6;0101" & Format(Date, "yy") & ";3112" & Format(Date, "yy") & ";" + vbCrLf
Put #iFile, , str
str = "E,1,______,_,__;F-Link KS Enternet;;"
Put #iFile, , str
Close #iFile
End Sub
Sub zRaporti()
Dim iFile As Integer
iFile = FreeFile()
Dim filepath As String
filepath = "C:\Temp\zRaportiNgaSM.INP"
If Len(Dir(filepath)) > 0 Then
Kill (filepath)
End If
Open filepath For Binary Access Write As #iFile
Dim str As String, IDF As Integer
str = "E,1,______,_,__;Printo Z raportin;F-Link ks;" + vbCrLf
Put #iFile, , str 'For example
str = "Z,1,______,_,__;" + vbCrLf
Put #iFile, , str
str = "E,1,______,_,__;F-Link ks Enternet;"
Put #iFile, , str
Close #iFile
End Sub
Sub Fshirja()
Dim iFile As Integer
iFile = FreeFile()
Dim filepath As String
filepath = "C:\Temp\FshierjaNgaSM.INP"
If Len(Dir(filepath)) > 0 Then
Kill (filepath)
End If
Open filepath For Binary Access Write As #iFile
Dim str As String, IDF As Integer
str = "O,1,______,_,__;ALL"
Put #iFile, , str 'For example
Close #iFile
End Sub
Public Function GetGUID() As String
GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").Guid, 2, 36)
End Function