locked
Mudule in Ms Access RRS feed

  • Question

  • I Create module in ms Acces But it doesn't work

    When I click button I Heve this error;

    Run-time 2185

    who can help me ?

    <code>


    Sub Fiskale(FL_ID As Integer)
    On Error GoTo shuki
    Dim rs As New ADODB.Recordset
    rs.Open "Select FATURAS, mat, emri, cmimish, Sasia from SUBFATURA where (((FATURAS)=" & FL_ID & "));", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    'rs.Open "SELECT Q_Fiskale.FL_ID, Q_Fiskale.Ar_ID, Q_Fiskale.Pershkrimi, Q_Fiskale.[Cmimi per njesi], " _
    '+ "Q_Fiskale.Sasia FROM Q_Fiskale WHERE (((Q_Fiskale.FL_ID)=" & FL_ID & "));", 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

    </Code>

     

     

    Tuesday, October 26, 2010 5:11 PM

Answers

All replies

  • I Create module in ms Acces But it doesn't work

    When I click button I Heve this error;

    Run-time 2185

    who can help me ?

    [code]


    Sub Fiskale(FL_ID As Integer)
    On Error GoTo shuki
    Dim rs As New ADODB.Recordset
    rs.Open "Select FATURAS, mat, emri, cmimish, Sasia from SUBFATURA where (((FATURAS)=" & FL_ID & "));", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    'rs.Open "SELECT Q_Fiskale.FL_ID, Q_Fiskale.Ar_ID, Q_Fiskale.Pershkrimi, Q_Fiskale.[Cmimi per njesi], " _
    '+ "Q_Fiskale.Sasia FROM Q_Fiskale WHERE (((Q_Fiskale.FL_ID)=" & FL_ID & "));", 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

    [/code]

     

     


    Tuesday, October 26, 2010 5:25 PM
  • Hello,

             Thank you for your post!  I would suggest posting your question in one of the (Microsoft Office > Microsoft Office Forums > Additional Microsoft Office Products Forums > Microsoft Office for Business Users: Visio, Project, InfoPath, and Access) forum located here:  (http://social.answers.microsoft.com/Forums/en/addbuz/threads).

            Hope that would be helpful.

           Have a great day!

          Thanks & regards,


    Shivendra Pratap Singh Tier 2 Application Support Server and Tools Online Operations Team
    Tuesday, October 26, 2010 5:53 PM