I got this JSON in VB6 (not .NET) inside a textbox:
[{"id":123,"key":"h73df", "birth_date":"20180101"}]
It returns no error when posting to an url..but the date is not inserted and I don't know why.
I already try different formats like:
"2018.01.01"
["20180101"]
2018.01.01
but won't work. I think I have to use something like cdate() but then I put all the JSON string into a textbox and all became a simple string..and doesn't work.
JSON itself doesn't care what format you use for the date. However, it is most commonly used in the JavaScript format which is ISO 8601 format.
That being said, you can create a string in this format using the following VB6 code (The below returns the time in UTC, if you want to use the local time you will need to call GetLocalTime API instead of GetSystemTime):
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Put inside module:
Private Type SYSTEMTIME '16 Bytes
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetJsonDateTime() As String
Dim NowTime As SYSTEMTIME
Dim sYear, sMonth, sDayOfWeek, sDay, sHour, sMinute, sSecond, sMilliseconds As String
Dim JsonDateTime As String
GetSystemTime NowTime
sYear = Format(NowTime.wYear, "0000")
sMonth = Format(NowTime.wMonth, "00")
sDay = Format(NowTime.wDay, "00")
sHour = Format(NowTime.wHour, "00") 'wHour - or + X depends local timezone
sMinute = Format(NowTime.wMinute, "00")
sSecond = Format(NowTime.wSecond, "00")
sMilliseconds = Format(NowTime.wMilliseconds, "000")
JsonDateTime = sYear & "-" & sMonth & "-" & sDay & "T" & sHour & ":" & sMinute & ":" & sSecond & "." & sMilliseconds & "Z"
GetJsonDateTime = JsonDateTime
End Function
Related
I'm trying to get Access to create a certificate for me. I've got almost everything worked out except for the date. I want the date to display as text.
I'm able to accomplish this with a module in Excel, but when I input it into Access as a function, it gives me a #Name? error. Here's what I have in the function (again, this works in Excel):
Function DateToWords(ByVal xRgVal As Date) As String
Dim xYear As String
Dim Hundreds As String
Dim Decades As String
Dim xTensArr As Variant
Dim xOrdArr As Variant
Dim xCardArr As Variant
xOrdArr = Array("1st", "2nd", "3rd", "4th", "5th", "6th", _
"7th", "8th", "9th", "10th", "11th", "12th", _
"13th", "14th", "15th", "16th", "17th", "18th", _
"19th", "20th", "21st", "22nd", _
"23rd", "24th", "25th", "26th", _
"27th", "28th", "29th", "30th", "31st")
xCardArr = Array("", "one", "two", "three", "tour", _
"five", "six", "seven", "eight", "nine", _
"ten", "eleven", "twelve", "thirteen", _
"fourteen", "fifteen", "sixteen", _
"seventeen", "eighteen", "nineteen")
xTensArr = Array("twenty", "thirty", "forty", "fifty", _
"sixty", "seventy", "eighty", "ninety")
xYear = CStr(Year(xRgVal))
Decades = Mid$(xYear, 3)
If CInt(Decades) < 20 Then
Decades = xCardArr(CInt(Decades))
ElseIf CInt(Decades) Like "*0" Then
Decades = xTensArr(CInt(Left$(Decades, 1)) - 2)
Else
Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _
xCardArr(CInt(Right$(Decades, 1)))
End If
Hundreds = Mid$(xYear, 2, 1)
If CInt(Hundreds) Then
Hundreds = xCardArr(CInt(Hundreds)) & " hundred "
Else
Hundreds = ""
End If
DateToWords = "This " & xOrdArr(Day(xRgVal) - 1) & " day of" & _
Format$(xRgVal, " mmmm, ") & _
xCardArr(CInt(Left$(xYear, 1))) & _
" thousand " & Hundreds & Decades
End Function
Code in Access that calls the function. This is in the text box on the report:
=DateToWords([Forms]![FrmMakeCert]![Date])
n Excel, this takes the date that I specify in a cell (e.g. 12/27/18) and turns it into:
"This 27th day of December, two-thousand eighteen"
That's what I'd like to accomplish in the Access report, pulling the date from a form.
Issue was caused by using the same name for both user-defined function and module namely DateToWords.
You should use different names.
Rename the module to, for instance, mdlDateToWords.
Steps to use.
First create a module in access and paste your codes.
Suppose in report you are displaying date to text in a textbox name txtDateText
In txtDateText data source enter following
=DateToWords([Forms]![Form1]![txtDate])
Remember: Form1 must be open and contain valid date otherwise it will show error. Form1 is form name, so it will be different in your case. Also text box name.
File download link
I'm consuming a web service in some legacy applications written in VB6. Right now I've been able to parse the JSON returned from a web service using the VB JSON parser found here: http://www.ediy.co.nz/vbjson-json-parser-library-in-vb6-xidc55680.html
However, I'm still hardcoding the JSON string that gets passed into the POST request payload.
Generically speaking:
result = WebRequestPost(url, "{""Id"":""" & productId & """,""Name"":""" & productName & """,""Category"":""" & productCat & """,""Price"":""" & productPrice & """}")
Is there a cleaner way that I can generate a JSON payload based on an object?
I ended up building my own assembler of sorts...
Dim jsonArray() As String
'_______________________________________________________________
'Initializes the opening and closing braces of the JSON payload
Public Sub JSONInitialize()
ReDim jsonArray(1)
jsonArray(0) = "{"
jsonArray(1) = "}"
End Sub
'_______________________________________________________________
'Adds a string value to the JSON payload
Public Sub JSONAddString(nFieldName As String, nValue As String)
Dim temp As String
temp = jsonArray(UBound(jsonArray))
Dim index As Integer
index = UBound(jsonArray)
ReDim Preserve jsonArray(UBound(jsonArray) + 1)
jsonArray(UBound(jsonArray)) = temp
jsonArray(index) = """" & nFieldName & """:""" & nValue & ""","
End Sub
'_______________________________________________________________
'Adds an integer value to the JSON payload
Public Sub JSONAddInt(nFieldName As String, nValue As Integer)
Dim temp As String
temp = jsonArray(UBound(jsonArray))
Dim index As Integer
index = UBound(jsonArray)
ReDim Preserve jsonArray(UBound(jsonArray) + 1)
jsonArray(UBound(jsonArray)) = temp
jsonArray(index) = """" & nFieldName & """:" & nValue & ","
End Sub
So (sanitized) execution ends up looking like:
Dim o As New MyObject
Call o.JSONInitialize
Call o.JSONAddString("My JSON String Field", "Test String Value")
Call o.JSONAddInt("My JSON Int Field", 25)
o.JSONSerialize() returns:
{"My JSON String Field":"Test String Value","My JSON Int Field": 25,}
Unfortunately it puts the comma at the end so it won't win any beauty contests but the API I'm calling doesn't care.
I am working on a code from a previous developer. This code has SystemTime set up.
Is there a way to get today date and minus 30 days in this format?
Code Below:
Public Function GetIsoTimestampTest() As String
Dim st As SYSTEMTIME
'Get the local date and time
GetSystemTime st
'Format the result
GetIsoTimestampTest = _
Format$(st.wYear, "0000") & "-" & _
Format$(st.wMonth, "00") & "-" & _
Format$(st.wDay, "00") & "T" & _
Format$(st.wHour, "00") & ":" & _
Format$(st.wMinute, "00") & ":" & _
Format$(st.wSecond, "00") & "Z"
End Function
Build a native date & time, add -30 days, format as a string:
utcInIsoFormat = Format$(DateAdd("d", -30, _
DateSerial(st.wYear, st.wMonth, st.wDay) _
+ TimeSerial(st.wHour, st.wMinute, st.wSecond)), "yyyy-mm-ddThh:nn:ssZ")
SYSTEMTIME appears to be a custom type defined elsewhere in your code. It's not a standard type available in Access VBA. So to use it effectively, you need to find the definition. Also GetSystemTime is also likely a custom function exclusive to your code. Here's a sample definition of a similar type, although it may not be exactly what's implemented in your system: http://custom-designed-databases.com/wordpress/2011/get-milliseconds-or-seconds-from-system-time-with-vba/
That said, System Time would refer to the Windows system time. You also have a native ability in VBA to get time using the Now() function. (https://msdn.microsoft.com/en-us/library/office/gg278671.aspx) This returns a variable with type Date, which is equivalent to a number where the integer represents days and the decimal represents time of day. An example to get 30 days prior to today would be:
Dim lastMonth as Date
Dim formattedDate as String
lastMonth = Now() - 30
formattedDate = Format(lastMonth, "yyyy-mm-ddThh:nn:ssZ")
DateSerial happily accepts a negative day count. Thus:
Public Function IsoDateMinus30() As Date
Dim st As SYSTEMTIME
Dim Result As Date
' Get the local date and time
GetSystemTime st
Result = DateSerial(st.wYear, st.wMonth, st.wDay - 30)
' To include time:
'
' Result = _
' DateSerial(st.wYear, st.wMonth, st.wDay - 30) + _
' TimeSerial(st.wHour, st.wMinute, st.wSecond)
IsoDateMinus30 = Result
End Function
I am trying to write a VBA code on msaccess to validate the data entries to avoid duplicates on a fault log database. It works for the stLinkCriteria which is a string datatype (short text) but not for stDCriteria which is a date data type... it keeps throwing an error "type mismatch" or "datatype mismatch" on this line
stDCriteria = "[datelogged] = #" & DateTime & "#"
The stDCriteria is showing 12:00:00am when I hover my mouse on the code
Although the data type for datelogged is Date/Time in the database...
Private Sub Form_AfterUpdate()
Dim NewTerminal As String
Dim stLinkCriteria As String
Dim DateTime As Date
Dim stDCriteria As Date
NewTerminal = Me.cboTerID.Value
DateTime = Me.txtDateLogged.Value
stLinkCriteria = "[serialptrid] = " & NewTerminal & ""
stDCriteria = "[datelogged] = #" & DateTime & "#"
If Me.SerialptrID = DLookup("[serialptrid]", "Fault_Log", stLinkCriteria) Then
If Me.DateLogged = DLookup("[datelogged]", "Fault_Log", stDCriteria) Then
MsgBox "This terminal " & NewTerminal & ", " & DateTime & ", has already been entered in this database." _
& vbCr & vbCr & "Please check terminal selected", vbInformation, "Duplicate information"
Me.Undo
End If
End If
End Sub
This code attempts to assign a string value to stDCriteria:
stDCriteria = "[datelogged] = #" & DateTime & "#"
So you must declare that variable as String instead of Date.
Dim stDCriteria As String
Also you can apply a yyyy-m-d format to your DateTime value. That format avoids confusion about whether your date is m/d/yyyy or d/m/yyyy format.
stDCriteria = "[datelogged] = #" & Format(DateTime, "yyyy-m-d") & "#"
I am importing a CSV file into a table in MS Access.
However there are many files in the folder with the same extension and the names include dates in "mm_dd_yyyy" format.
Example: Lets say I have two CSV files:
my_music_02_10_2013_01_58_07_PM.csv
my_music_02_11_2013_03_04_07_PM.csv
Both files are in the same folder, myfolder. I want to import the file whose name contains the newest date.
Here is a short snippet of my code:
strPath = "F:\myfolder\"
strFile = Dir(strPath & "my_music" & "*.csv")
How can I determine which of my "my_music*.csv" is newest?
Seems to me the key is to extract the Date/Time from each file name so that you may compare those to find which of them is newest.
Here is an Immediate window session testing the function included below. The function returns null if it can't find a string which represents a valid date.
? DateFromFilename("my_music_02_10_2013_01_58_07_PM.csv")
2/10/2013 1:58:07 PM
? DateFromFilename("my_music_no_date_here.csv")
Null
Public Function DateFromFilename(ByVal pFileName As String) As Variant
Dim strBaseName As String
Dim strDate As String
Dim strPieces() As String
Dim varReturn As Variant
varReturn = Null
strBaseName = Split(pFileName, ".")(0)
'Debug.Print "strBaseName: " & strBaseName
strPieces = Split(strBaseName, "_")
If UBound(strPieces) = 8 Then
strDate = strPieces(4) & "-" & strPieces(2) & _
"-" & strPieces(3) & " " & strPieces(5) & ":" & _
strPieces(6) & ":" & strPieces(7) & " " & strPieces(8)
End If
'Debug.Print "strDate: " & strDate
If IsDate(strDate) Then
varReturn = CDate(strDate)
End If
DateFromFilename = varReturn
End Function