Export Data from Access table to Json file

I

ivonsurf123

Registered User.
Local time
Today, 11:40
Joined
Dec 8, 2017
Messages
69
Hello,

This is a long code I am trying to submit/ add data when click on the Add button, need help, very new at this Rest API with access, I using an API from JAMS which is a Job Access and Management System tool to schedule and create jobs. The only thing I got is to get the parameters in Access when created in JAMS, but not from Access to Jams :(

I have an Add button in Access needs to communicate with JAMS to add parameters in a job, most of the code is commented, I was testing but no luck, if someone knows a better and simple way to do it, please teach me since I am very new to the concept of REST API and access, I will appreciate it.

Code: 
Private Sub cmdAddParameter_Click()

On Error GoTo Err_Error

    Dim reader As New XMLHTTP60     'Set API variable
    Dim writter As New XMLHTTP60
    Dim coll As Collection          'Used for data received from JAMS after its passed through Class Module
    Dim JSON As New clsJSONParser   'Variable set to Class Module
    Dim rstToken As Recordset       'Used to check if token exists
    Dim rstParam As Recordset
    Dim Param As Variant
    Dim Response
    
    Dim strToken As String          'String for Token table
    Dim URl As String               'Url to JAMS API
    Dim sLoginToken As String       'Existing token after login was success
    Dim sBody, sParameters As String
    Dim iInstr As Long, iStart As Long, iEnd As Long
    Dim strParam As String, iParameters As Long
    Dim sJobName As String
    Dim strOne As String, strTwo As String, sSearch As String
    Dim iSemi As Long, iComa As Long, iField As Long
    Dim sString As String, sStr1
    
    'IEClearCache
    
    sJobName = [Forms]![Navigation Form]![NavigationSubform].Form!lstJobs.SelectedItem
    
    Response = MsgBox("Would you like to submit the current parameter?", vbExclamation + vbYesNo, "Add Parameter")
    If Response = vbYes Then
        'MsgBox "Submitting: " & [Forms]![Navigation Form]![NavigationSubform].Form![lstJobs].Column(0, [Forms]![Navigation Form]![NavigationSubform].Form![lstJobs].
[ListIndex] + 1)
    
        'sBody = "{ ""name"": """ & sJobName & """ }, { ""parameters"": " & sParameters & "}"
        'Debug.Print sBody
        
        'Check if we have token
        If sToken = "" Then
            
            'Create Select query for todays date
            strToken = "Select * from tbl_JAMS_Token where TokenDate = #" & Format(Date, "mm/dd/yyyy") & "#"
            'Debug.Print strToken
            
            'Open recordset and retrieve any data
            Set rstToken = CurrentDb.OpenRecordset(strToken, dbOpenDynaset, dbSeeChanges)
            
            'Check if anything was retrieved from table
            If rstToken.RecordCount > 0 Then
                'Set variable with avaiable token
                sToken = rstToken!Token
            Else
                LoginDev
                LoginProd
                
'                If sConnected <> "Connected" Then
'                    Forms![Main Menu].Form!txtStatus = sConnected
'                    Resume Exit_Sub
'                End If
            End If
            
            'Close connection
            rstToken.Close
        
        End If

        'Create Token string to be passed to JAMS API
        'sLoginToken = "Bearer " & sToken
        Select Case sJAMSServer
             Case "Development"
                 sLoginToken = "Bearer " & sTokenDev
             Case "Production"
                 sLoginToken = "Bearer " & sTokenProd
         End Select
         
         'Create Token string to be passed to JAMS API
         
         Select Case sJAMSServer
             Case "Development"
                URl = "http://10.29.144.35/jams_api/api/submit?name=" & [Forms]![Navigation Form]![NavigationSubform].Form!lstJobs.SelectedItem
             Case "Production"
                URl = "http://10.30.20.72/jams_api/api/submit?name=" & [Forms]![Navigation Form]![NavigationSubform].Form!lstJobs.SelectedItem
         End Select

        'Me.txtConnection = "Connecting to JAMS Server, Please wait..."
        DoEvents

        'Set url for connection to JAMS
        'URl = "http://10.29.144.35/jams_api/api/submit?name=" & [Forms]![Navigation Form]![NavigationSubform].Form![lstJobs].Column(0, [Forms]![Navigation Form]![NavigationSubform].Form![lstJobs].
[ListIndex] + 1)

        'Open connection to JAMS API
        reader.Open "GET", URl, False

        'Set some headers to authenticate along with Token
        reader.setRequestHeader "Authorization", sLoginToken

        'Request data from JAMS APi
        reader.send

        'Check request status, if Readystate = 4 all fine
        Do Until reader.ReadyState = 4 'Completed
            DoEvents
        Loop

        'If Status = 200 then all OK
        If reader.Status = 200 Then
            
            'Debug.Print reader.ResponseText
            
            'Firstly find the parameters data in the reader.ResponseText
            iInstr = InStr(1, reader.responseText, """paramName""")
            If iInstr <> 0 Then
                iInstr = InStrRev(reader.responseText, "[", -1)
                If iInstr <> 0 Then
                    iStart = iInstr
                    iEnd = InStr(iStart, reader.responseText, "]")
                    strParam = Mid(reader.responseText, iStart, iEnd - iStart + 1)
                    'Debug.Print strParam
                End If
            End If
            
            'Find the data and replace it in the string
            strParam = "Select * from tbl_JAMS_Job_Parameter_Details" ' where parameterOrigin='job'"
            Set rstParam = CurrentDb.OpenRecordset(strParam, dbOpenDynaset, dbSeeChanges)
            If rstParam.RecordCount > 0 Then
                rstParam.MoveLast
                rstParam.MoveFirst
                
                sParameters = ""
                
                sBody = reader.responseText
                
                While Not rstParam.EOF
                    
                    sSearch = """paramID"":" & rstParam!paramID
                    
                    iInstr = InStr(1, sBody, sSearch)
                    If iInstr <> 0 Then
                        iInstr = InStrRev(sBody, "{", iInstr)
                        If iInstr <> 0 Then
                            iStart = iInstr
                            iEnd = InStr(iStart, sBody, "}")
                            strOne = Mid(sBody, iStart, iEnd - iStart + 1)
                            strTwo = Mid(sBody, iStart, iEnd - iStart + 1)
'                            Debug.Print strOne
'                            Debug.Print strTwo & vbCrLf
                        End If
                        'MsgBox sSearch
                    End If
                    
'                    iField = InStr(1, strTwo, """allowEntry""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """allowEntry"":" & rstParam!allowEntry
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """dataType""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """dataType"":""" & rstParam!DataType & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """defaultFormat""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """defaultFormat"":""" & rstParam!defaultFormat & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """detailID""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """detailID"":" & rstParam!detailID
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """globalName""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """globalName"":""" & rstParam!globalName & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """globalOverride""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """globalOverride"":" & rstParam!globalOverride
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """helpText""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """helpText"":""" & rstParam!helpText & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """hide""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """hide"":" & rstParam!hide
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """jobID""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """jobID"":" & rstParam!JobID
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """length""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """length"":" & rstParam!length
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """mustFill""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """mustFill"":" & rstParam!mustFill
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """parameterOrigin""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """parameterOrigin"":""" & rstParam!parameterOrigin & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """paramID""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """paramID"":" & rstParam!paramID
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
                    
'                    iField = InStr(1, strTwo, """paramName""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """paramName"":""" & rstParam!paramName & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
                    
                    iField = InStr(1, strTwo, """paramValue""")
                    If iField <> 0 Then
                        iComa = InStr(iField, strTwo, ",")
                        If iComa <> 0 Then
                            sString = Mid(strTwo, iField, iComa - iField)
                        End If
                        
                        If Not IsNull(rstParam!paramValue) Then
                            sStr1 = """paramValue"":""" & Replace(rstParam!paramValue, "\", "\\") & """"
                        Else
                            sStr1 = """paramValue"":"""""
                        End If
                        
                        strTwo = Replace(strTwo, sString, sStr1)
                        
                    End If
                    
'                    iField = InStr(1, strTwo, """prompt""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """prompt"":""" & rstParam!prompt & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """required""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """required"":" & rstParam!Required
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """uppercase""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """uppercase"":" & rstParam!uppercase
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """validationData""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        End If
'
'                        sStr1 = """validationData"":""" & rstParam!validationData & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
'
'                    iField = InStr(1, strTwo, """validationType""")
'                    If iField <> 0 Then
'                        iComa = InStr(iField, strTwo, ",")
'                        If iComa <> 0 Then
'                            sString = Mid(strTwo, iField, iComa - iField)
'                        Else
'                            iComa = InStr(iField, strTwo, "}")
'                            If iComa <> 0 Then
'                                sString = Mid(strTwo, iField, iComa - iField)
'                            End If
'
'                        End If
'
'                        sStr1 = """validationType"":""" & rstParam!validationType & """"
'
'                        strTwo = Replace(strTwo, sString, sStr1)
'
'                    End If
                    
'                    Debug.Print strOne
'                    Debug.Print strTwo & vbCrLf
                    
                    sBody = Replace(sBody, strOne, strTwo)
                    
                    If sParameters = "" Then
                        'sParameters = "{""allowEntry"":" & rstParam!allowEntry & ",""dataType"":""" & rstParam!DataType & """,""defaultFormat"":""" & rstParam!defaultFormat & """,""detailID"":" & rstParam!detailID & ",""globalName"":""" & rstParam!globalName & """,""globalOverride"":" & rstParam!globalOverride & ",""helpText"":""" & rstParam!helpText & """,""hide"":" & rstParam!hide & ",""jobID"":" & rstParam!JobID & ",""length"":" & rstParam!length & ",""mustFill"":" & rstParam!mustFill & ",""parameterOrigin"":""" & rstParam!parameterOrigin & """,""paramID"":" & rstParam!paramID & ",""paramName"":""" & rstParam!paramName & """,""paramValue"":""" & rstParam!paramValue & """,""prompt"":""" & rstParam!prompt & """,""required"":" & rstParam!Required & ",""uppercase"":" & rstParam!uppercase & ",""validationData"":""" & rstParam!validationData & """,""validationType"":""" & rstParam!validationType & """}"
                        'sParameters = "{ ""allowEntry"":" & rstParam!allowEntry & ", ""dataType"":" & rstParam!DataType & ",""defaultFormat"":" & rstParam!defaultFormat & ", ""jobID"":" & rstParam!JobID & ",""paramID"":" & rstParam!paramID & ", ""paramName"":""" & rstParam!paramName & """,""paramValue"":""" & rstParam!paramValue & """ }"
                        'sParameters = "{""paramValue"":""" & rstParam!paramValue & """}"
                        'Debug.Print sParameters
                    Else
                        'sParameters = sParameters & ",{""allowEntry"":" & rstParam!allowEntry & ",""dataType"":""" & rstParam!DataType & """,""defaultFormat"":""" & rstParam!defaultFormat & """,""detailID"":" & rstParam!detailID & ",""globalName"":""" & rstParam!globalName & """,""globalOverride"":" & rstParam!globalOverride & ",""helpText"":""" & rstParam!helpText & """,""hide"":" & rstParam!hide & ",""jobID"":" & rstParam!JobID & ",""length"":" & rstParam!length & ",""mustFill"":" & rstParam!mustFill & ",""parameterOrigin"":""" & rstParam!parameterOrigin & """,""paramID"":" & rstParam!paramID & ",""paramName"":""" & rstParam!paramName & """,""paramValue"":""" & rstParam!paramValue & """,""prompt"":""" & rstParam!prompt & """,""required"":" & rstParam!Required & ",""uppercase"":" & rstParam!uppercase & ",""validationData"":""" & rstParam!validationData & """,""validationType"":""" & rstParam!validationType & """}"
                        'sParameters = sParameters & ", { ""jobID"":" & rstParam!JobID & ",""paramID"":" & rstParam!paramID & ", ""paramName"":""" & rstParam!paramName & """,""paramValue"":""" & rstParam!paramValue & """ }"
                        'sParameters = sParameters & ",{""paramValue"":""" & rstParam!paramValue & """}"
                        'Debug.Print sParameters
                    End If
                    
                    rstParam.MoveNext
                Wend
                
                sParameters = "[" & sParameters & "]"
            End If
            
            rstParam.Close
            
            'Me.txtConnection = "Saving Agent List, Please wait..."
            DoEvents
            
            'Debug.Print sBody

            'Set url for connection to JAMS
            'URl = "http://10.29.144.35/jams_api/api/submit"
            Select Case sJAMSServer
                Case "Development"
                    URl = "http://10.29.144.35/jams_api/api/submit"
                Case "Production"
                    URl = "http://10.30.20.72/jams_api/api/submit"
            End Select

            'Open connection to JAMS API
            writter.Open "POST", URl, False

            'Set some headers to authenticate along with Token
            writter.setRequestHeader "Authorization", sLoginToken
            writter.setRequestHeader "Content-Type", "application/json"

            'Request data from JAMS APi
            writter.send (sBody)

            If writter.Status = 200 Then
                MsgBox "Job submitted. Check Queue."
                
                strParam = "Select * from tbl_JAMS_Job_Parameter_Details where parameterOrigin='job'"
                Set rstParam = CurrentDb.OpenRecordset(strParam, dbOpenDynaset, dbSeeChanges)
                If rstParam.RecordCount > 0 Then
                    rstParam.MoveLast
                    rstParam.MoveFirst
                    
                    sParameters = "AD-HOC Submitted with parameters |"
                    While Not rstParam.EOF
                        If Not IsNull(rstParam!paramValue) And rstParam!paramValue <> "" Then
                            sParameters = sParameters & vbCrLf & rstParam!paramName & ": " & rstParam!paramValue
                        End If
                        rstParam.MoveNext
                    Wend
                End If
                rstParam.Close
                Set rstParam = Nothing
                
                JAMS_Audit_Log DLookup("[JobID]", "tbl_JAMS_" & sWhichServer & "_Job", "JobName='" & sJobName & "'"), sJobName, "AD-HOC JOB SUBMITTED", sParameters
            
            Else
                MsgBox "Failed to run (ErrorCode: " & writter.Status & ")"
            End If

        Else

            'Me.txtConnection = reader.status & vbCrLf & reader.ResponseText
        End If
    End If
    
    'DoCmd.Close

Exit_Sub:
    
    Set rstToken = Nothing
    Set rstAgent = Nothing
    Set rstParam = Nothing
    Set reader = Nothing
    Set writter = Nothing
    Set coll = Nothing
    Set JSON = Nothing
    
    Exit Sub
    
Err_Error:
    MsgBox "Description: " & Err.Description & vbCrLf & "Error Number: " & Err.Number
    Resume Next
    Resume Exit_Sub
End Sub
 
Last edited:
What does 'no luck' mean - error message, wrong results, nothing happens?
 
No luck means that I was not able to send data from Access Form clicking in the Add button to JAMS, but when I am in the JAMS tool and add parameters in a Job, then go to Access I am able to see the parameters I added in JAMS.
 
Some questions.

Is this code you have written yourself or obtained via the API?
If the latter do you understand what each part of the code is meant to do?
Does it compile without errors?
A significant part of your code is commented out. Why?

Have you tried stepping through the code and adding debug lines to check what is happening at each stage?
 
Last edited:
"Not able to send" still doesn't tell us much. Do you get error message? Does the code divert to the error handler?

As Colin suggests, step debug, disable error handling while developing code (just comment the On Error GoTo).
 
You must log in or register to reply here.

Similar threads

N
Data source changed from a table to a query
Replies
13
Views
524
Pat Hartman
P
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
722
BlueFllame
B
L
Export data from Access to Word with VBA
Replies
12
Views
1,564
arnelgp
arnelgp
J
Solved Insert xml data from responsetext to table in access with VBA
Replies
14
Views
1,743
john_gringo
J
D
Outlook macro to extract data from emails to .txt file
Replies
5
Views
1,460
theDBguy
theDBguy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom