Parsing JSON (US BLS) in VBA from MS Access - json

Thank you in advance for your assistance.
I am using a JSON VB6 Parser which can be found at: VB JSON Parser
I have the following JSON response (Comes from the BLS website, specifically this link Here:
{"status":"REQUEST_SUCCEEDED","responseTime":71,"message":[],"Results":{
"series":
[{"seriesID":"WPS012","data":[{"year":"2014","period":"M11","periodName":"November","value":"153.6","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M10","periodName":"October","value":"147.4","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M09","periodName":"September","value":"146.5","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M08","periodName":"August","value":"156.9","footnotes":[{"code":"P","text":"Preliminary. All indexes are subject to revision four months after original publication."}]},{"year":"2014","period":"M07","periodName":"July","value":"156.4","footnotes":[{}]},{"year":"2014","period":"M06","periodName":"June","value":"179.6","footnotes":[{}]},{"year":"2014","period":"M05","periodName":
"May","value":"205.4","footnotes":[{}]},{"year":"2014","period":"M04","periodName":"April","value":"201.6","footnotes":[{}]},{"year":"2014","period":"M03","periodName":"March","value":"188.1","footnotes":[{}]},{"year":"2014","period":"M02","periodName":"February","value":"180.2","footnotes":[{}]},{"year":"2014","period":"M01","periodName":"January","value":"177.8","footnotes":[{}]},{"year":"2013","period":"M12","periodName":"December","value":"183.2","footnotes":[{}]},{"year":"2013","period":"M11","periodName":"November","value":"180.4","footnotes":[{}]},{"year":"2013","period":"M10","periodName":"October","value":"186.4","footnotes":[{}]},{"year":"2013","period":"M09","periodName":"September","value":"197.1","footnotes":[{}]},{"year":"2013","period":"M08","periodName":"August","value":"222.2","footnotes":[{}]},{"year":"2013","period":"M07","periodName":"July","value":"252.9","footnotes":[{}]},{"year":"2013","period":"M06","periodName":"June","value":"259.0","footnotes":[{}]},{"year":"2013","period":"M05","p
eriodName":"May","value":"263.7","footnotes":[{}]},{"year":"2013","period":"M04","periodName":"April","value":"249.3","footnotes":[{}]},{"year":"2013","period":"M03","periodName":"March","value":"268.1","footnotes":[{}]},{"year":"2013","period":"M02","periodName":"February","value":"267.1","footnotes":[{}]},{"year":"2013","period":"M01","periodName":"January","value":"279.7","footnotes":[{}]},{"year":"2012","period":"M12","periodName":"December","value":"283.2","footnotes":[{}]},{"year":"2012","period":"M11","periodName":"November","value":"280.8","footnotes":[{}]},{"year":"2012","period":"M10","periodName":"October","value":"286.7","footnotes":[{}]},{"year":"2012","period":"M09","periodName":"September","value":"285.2","footnotes":[{}]},{"year":"2012","period":"M08","periodName":"August","value":"298.9","footnotes":[{}]},{"year":"2012","period":"M07","periodName":"July","value":"275.8","footnotes":[{}]},{"year":"2012","period":"M06","periodName":"June","value":"226.9","footnotes":[{}]},{"year":"2012","perio
d":"M05","periodName":"May","value":"233.7","footnotes":[{}]},{"year":"2012","period":"M04","periodName":"April","value":"239.9","footnotes":[{}]},{"year":"2012","period":"M03","periodName":"March","value":"243.6","footnotes":[{}]},{"year":"2012","period":"M02","periodName":"February","value":"239.9","footnotes":[{}]},{"year":"2012","period":"M01","periodName":"January","value":"243.8","footnotes":[{}]}]}]
}}`
I am able to use the parser to return "status", "responseTime" and "message". Anything beyond that (the opening of the second curly bracket) I get nothing.
Below is the code I am trying to use:
Dim p As Object
Set p = JSON.parse(gbl_response)
'Print the text of a nested property '
Debug.Print p.Item("responseTime")
'Print the text of a property within an array '
Debug.Print p.Item("Results").Item("series").Item("seriesID")
The print of p.Item("responseTime") works and returns "71", however I get an "invalid call procedure or argument" error on the second print attempt.
For the life of me, I've searched around and have not found any solutions. I've tried this which seemed almost identical, but alas, I've tried to replicate the solution here and it seems to have not worked.
Thank you for you assistance!

Public Const jsonSource As String = "{" & _
"""status"": ""REQUEST_SUCCEEDED"", " & _
"""responseTime"": 71, " & _
"""message"": [ " & _
"], " & _
"""Results"": { " & _
"""series"": [ " & _
"{ " & _
"""seriesID"": ""WPS012"", " & _
"""data"": [ " & _
"{ " & _
"""year"": ""2014"", " & _
"""period"": ""M11"", " & _
"""periodName"": ""November"", " & _
"""value"": ""153.6"", " & _
"""footnotes"": [ " & _
"{ " & _
"""code"": ""P"", " & _
"""text"": ""Preliminary. All indexes are subject to revision four months after original publication."" " & _
"} " & _
"] " & _
"} " & _
"] " & _
"}]}}"
Sub JsonTest()
Dim jsonData As Scripting.Dictionary
Set jsonData = JSON.parse(jsonSource)
Dim responseTime As String
responseTime = jsonData("responseTime")
Dim results As Scripting.Dictionary
Set results = jsonData("Results")
Dim series As Collection
Set series = results("series")
Dim seriesItem As Scripting.Dictionary
For Each seriesItem In series
Dim seriesId As String
seriesId = seriesItem("seriesID")
Debug.Print seriesId
Dim data As Collection
Set data = seriesItem("data")
Dim dataItem As Scripting.Dictionary
For Each dataItem In data
Dim year As String
year = dataItem("year")
Dim period As String
period = dataItem("period")
Dim periodName As String
periodName = dataItem("periodName")
Dim value As String
value = dataItem("value")
Dim footnotes As Collection
Set footnotes = dataItem("footnotes")
Dim footnotesItem As Scripting.Dictionary
For Each footnotesItem In footnotes
Dim code As String
code = footnotesItem("code")
Dim text As String
text = footnotesItem("text")
Next footnotesItem
Next dataItem
Next seriesItem
End Sub

Related

POST error using VBA (MS Access) for API to Neto site

I have an access database which I'm using to create a json POST API to a website utilising Neto (https://developers.neto.com.au/documentation/engineers/api-documentation). I am new to APIs, but have been researching for several months and making progress in understanding how it works. I have managed to get a 200 status response from the request which would indicate the header info (including authentication is correct) but error in relation to the body (I believe).
Code as per below:
Dim reader As New XMLHTTP60
Dim username As String, APIkey As String
Dim strJson As String
strJson = "{" & _
"'Filter': {" & _
"'OrderStatus': 'Pick'," & _
"'OutputSelector': [" & _
"'OrderID'," & _
"'ShippingOption'," & _
"]," & _
"}" & _
"}"
username = "xxx"
APIkey = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
reader.Open "POST", "https://www.yoursite.co.nz/do/WS/NetoAPI", False
reader.setRequestHeader "NETOAPI_USERNAME", username
reader.setRequestHeader "NETOAPI_KEY", APIkey
reader.setRequestHeader "Content-Type", "application/json"
reader.setRequestHeader "Accept", "application/json"
reader.setRequestHeader "NETOAPI_ACTION", "GetOrder"
reader.send strJson
Debug.Print reader.Status
Debug.Print reader.responseText
error message:
{"CurrentTime":"2021-09-17 02:42:50","Ack":"Error","Messages":[{"Error":{"Message":"JSON Error","SeverityCode":"Error"},"Warning":{"Message":"Warning","SeverityCode":"Warning","Description":"'\"' expected, at character offset 1 (before \"'Filter': {'OrderSta...\")"}}]}
Initially i am just trying to retrieve 2 pieces of data (OrderID and ShippingOption) for any orders with status of Pick.
i have tried replacing all ' with "" as i've seen in other posts along with a few other variations but with no luck.
Any help would be appreciated. Thanks
You are using single quote instead of double quotes in your JSON
The value of Filter is a collection enclosed with [ ] so I believe you need to wrap Pick as well (despite there's only 1 value).
You have an extra , after ShippingOption when it's the last value so remove that.
Try this instead:
strJSON = "{" & _
"""Filter"": {" & _
"""OrderStatus"": [""Pick""]," & _
"""OutputSelector"": [" & _
"""OrderID""," & _
"""ShippingOption""" & _
"]" & _
"}" & _
"}"
Above will produce the JSON below:
{"Filter": {"OrderStatus": ["Pick"],"OutputSelector": ["OrderID","ShippingOption"]}}

Get value of node in MS Access using JSOn

I am using VB-JSON parser to get data from an API and saving the data in MS access table.
I am not able to figure out how to access the -KLj9kXnKd-9txfyIqM8 and -KLjJoT7gXCMq_jHx2_z.
I have Table structure as below, and want to save the data as shown below.
|ServerID |Name |Mobile
|-KLj9kXnKd-9txfyIqM8 |Adarsh |9987
|-KLjJoT7gXCMq_jHx2_z |Manas |022
JSON
{
"-KLj9kXnKd-9txfyIqM8": {
"personmobile": "9987",
"personname": "Adarsh"
},
"-KLjJoT7gXCMq_jHx2_z": {
"personmobile": "022",
"personname": "Manas"
}
}
VBA
Public Sub GetPerson()
'I have code here which gets the json as above from api.
Dim egTran As String
If reader.Status = 200 Then
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPerson", dbOpenDynaset, dbSeeChanges)
egTran = "[" & reader.responseText & "]"
Set coll = Json.parse(egTran)
For Each contact In coll
rs.AddNew
rs!Name = contact.Item("personname")
rs!Mobile = contact.Item("personmobile")
rs!ServerID = contact.Item("??????")
what do I write in ??????
rs.Update
Next
End If
End Sub
I am also open to using any other parser. The API is based on Firebase Database
I'm not familiar with VB-JSON, but obviously "??????" is not an item of contact.
Thus, if I run this test function:
Public Sub TestJsonText()
Dim DataCollection As Collection
Dim ResponseText As String
ResponseText = _
"{" & _
" ""-KLj9kXnKd-9txfyIqM8"": {" & _
" ""personmobile"": ""9987""," & _
" ""personname"": ""Adarsh""" & _
" }," & _
" ""-KLjJoT7gXCMq_jHx2_z"": {" & _
" ""personmobile"": ""022""," & _
" ""personname"": ""Manas""" & _
" }" & _
"}"
If ResponseText <> "" Then
Set DataCollection = CollectJson(ResponseText)
MsgBox "Retrieved" & Str(DataCollection.Count) & " root member(s)", vbInformation + vbOKOnly, "Web Service Success"
End If
Call ListFieldNames(DataCollection)
Set DataCollection = Nothing
End Sub
using the Json modules from VBA.CVRAPI it will print:
root
-KLj9kXnKd-9txfy
personmobile 9987
personname Adarsh
-KLjJoT7gXCMq_jH
personmobile 022
personname Manas
From the function ListFieldNames you can pick MemberName for the field name and DataCollection(Index)(CollectionItem.Data) for the field value to add records.

Trouble parsing JSON with vba

I can get what appears to be a valid JSON string from a web query, however, I cannot set items correctly for the life of me. Need to confirm that I'm not losing my mind...
'Call for available reports
Dim URLReporta As String
Dim JSONa As Object
Dim var As Object
Set myrequesta = CreateObject("winhttp.winhttprequest.5.1")
URLReporta = ("https://secure.saashr.com:443/ta/rest/v1/reports?type=Saved&company%3shortname=" & Company)
myrequesta.Open "GET", URLReporta, False
myrequesta.setRequestHeader "Accept", "application/json"
myrequesta.setRequestHeader "Authentication", "Bearer " & Token
myrequesta.setRequestHeader "Content-Type", "application/json"
myrequesta.Send
Set JSONa = JsonConverter.ParseJson(myrequesta.responseText)
Set var = JSONa("SavedName")
Debug.Print var.Count
I get an error on the line Set var = JSONa("SavedName"):
run-time error '424': object required
myrequesta.responseText value is as follows:
{"reports":[{"SavedName":"This Year","SettingId":18959322},{"SavedName":"Time Off Requests","SettingId":18960210},{"SavedName":"Calc Hours Summary","SettingId":18960209},{"SavedName":"roster","SettingId":18960211},{"SavedName":"E/D/T","SettingId":18823042},{"SavedName":"TestZDR","SettingId":18957188}]}
The structure returned by JsonConverter.ParseJson function doesn't work such way. For your particular JSON it contains 3 levels:
Root-level object has only one property reports, which contains second-level array, which in turn contains 6 third-level objects, having properties SavedName and SettingId. You are trying to get third-level's object property value from root-level object.
First you need to get second-level array, then loop through it's elements, containing objects, and retrieve the SavedName properties' values of that objects. Here is the example:
'Call for available reports
Dim URLReporta As String
Dim JSONa As Object
Dim var As Object
Dim rep As Variant
Set myrequesta = CreateObject("winhttp.winhttprequest.5.1")
URLReporta = ("https://secure.saashr.com:443/ta/rest/v1/reports?type=Saved&company%3shortname=" & Company)
myrequesta.Open "GET", URLReporta, False
myrequesta.setRequestHeader "Accept", "application/json"
myrequesta.setRequestHeader "Authentication", "Bearer " & Token
myrequesta.setRequestHeader "Content-Type", "application/json"
myrequesta.Send
Set JSONa = JsonConverter.ParseJson(myrequesta.responseText) ' root level object
Set var = JSONa("reports") ' second level array
For Each rep In var ' third level objects
Debug.Print rep("SavedName") ' property "SavedName" value of current third level object
Next
Here is the output:
If you want just to get the number of reports, then get the array and the number of elements in it:
Debug.Print JSONa("reports").Count
JSON objects can be thought of as a collection of dictionaries. So you have to walk through the inner values such as SavedName to retrieve whole dictionary objects (all SavedName values) or specific string values at indexed locations (one SavedName value):
Public Sub GetJSONRequest()
Dim jsonStr As String
jsonStr = "{" _
& " ""reports"": [{" _
& " ""SavedName"": ""This Year""," _
& " ""SettingId"": 18959322" _
& " }, {" _
& " ""SavedName"": ""Time Off Requests""," _
& " ""SettingId"": 18960210" _
& " }, {" _
& " ""SavedName"": ""Calc Hours Summary""," _
& " ""SettingId"": 18960209" _
& " }, {" _
& " ""SavedName"": ""roster""," _
& " ""SettingId"": 18960211" _
& " }, {" _
& " ""SavedName"": ""E/D/T""," _
& " ""SettingId"": 18823042" _
& " }, {" _
& " ""SavedName"": ""TestZDR""," _
& " ""SettingId"": 18957188" _
& " }]" _
& " }"
Dim JSONa As Object, element As Object, e As Variant, i As Variant, var As Variant
Set JSONa = ParseJson(jsonStr)
' DICTIONARY OBJECT
Set element = CreateObject("Scripting.Dictionary")
Set element = JSONa("reports")
' OUTER DICTIONARY
For Each e In element
' INNER COLLECTION OF DICTIONARIES
For Each i In e
Debug.Print i & " " & e(i)
Next i
Next e
' STRING VALUE OF FIRST SAVEDNAME VALUE
var = JSONa("reports")(1)("SavedName")
Debug.Print var
Set element = Nothing
Set JSONa = Nothing
End Sub
Output
SavedName This Year
SettingId 18959322
SavedName Time Off Requests
SettingId 18960210
SavedName Calc Hours Summary
SettingId 18960209
SavedName roster
SettingId 18960211
SavedName E/D/T
SettingId 18823042
SavedName TestZDR
SettingId 18957188
This Year

Parsing JSON (US BLS) in VBA from MS Access, update

So, I had previously asked a question that was successfully answered (here: Parsing JSON (US BLS) in VBA from MS Access)
The new response I get that differs from the original question is that I've added a request to capture calculations. I've tried adding as a collection and scripting dictionary like footnotes but I see the format is not quite the same, and therefore I think it results in null when I try to gather the 1,3,6 and 12 month changes. I'd like to have some help figuring out how to capture those changes in the following response:
{
"status":"REQUEST_SUCCEEDED",
"responseTime":64,
"message":["BLS does not produce net change calculations for Series WPU381103"],
"Results":
{
"series":
[
{
"seriesID":"WPU381103",
"data":
[
{
"year":"2014",
"period":"M12",
"periodName":"December",
"value":"98.9",
"footnotes":
[
{
"code":"P",
"text":"Preliminary. All indexes are subject to revision four months after original publication."
}
],
"calculations":
{
"net_changes":{},
"pct_changes":
{
"1":"0.0",
"3":"0.1",
"6":"0.0",
"12":"-0.7"
}
}
},
{
"year":"2014",
"period":"M11",
"periodName":"November",
"value":"98.9",
"footnotes":
[
{
"code":"P",
"text":"Preliminary. All indexes are subject to revision four months after original publication."
}
],
"calculations":
{
"net_changes":{},
"pct_changes":
{
"1":"0.1",
"3":"-0.4",
"6":"0.0",
"12":"-0.7"
}
}
},...
You will notice that there is a part now that says calculations, and seperates values by net changes, and percent changes. I am trying to get the percent changes within the "1", "3", "6" and "12" data items.
Here is the current code I'm that does NOT find calculations but captures all the other data:
response = http.responseText
jsonSource = response
I = 0
Dim jsonData As Scripting.Dictionary
Set jsonData = JSON.parse(jsonSource)
Dim responseTime As String
responseTime = jsonData("responseTime")
Dim results As Scripting.Dictionary
On Error Resume Next
Set results = jsonData("Results")
Dim series As Collection
On Error Resume Next
Set series = results("series")
Dim seriesItem As Scripting.Dictionary
For Each seriesItem In series
Dim seriesId As String
seriesId = seriesItem("seriesID")
Dim Data As Collection
Set Data = seriesItem("data")
Dim dataItem As Scripting.Dictionary
For Each dataItem In Data
Dim Year As String
Year = dataItem("year")
I = 1 + I
Dim Period As String
Period = dataItem("period")
Dim periodName As String
periodName = dataItem("periodName")
Dim Value As String
Value = dataItem("value")
Dim footnotes As Collection
Set footnotes = dataItem("footnotes")
Dim footnotesItem As Scripting.Dictionary
For Each footnotesItem In footnotes
Dim Code As String
Code = footnotesItem("code")
Dim text As String
text = footnotesItem("text")
Next footnotesItem
Next dataItem
Next seriesItem
Pretty straight forward. Remember, the JSON module implements JavaScript arrays as collections and objects as Scripting.Dictionary instances.
In your context, [..].calculations, [..].calculations.net_changes and [..].calculations.pct_changes are all objects so they are all converted to Dictionary objects.
So in your code, after the For Each footnotesItem In footnotes: [..]: Next footnotesItem block (therefore, above & before the Next dataItem line), you could add the following lines:
Dim calculations As Scripting.Dictionary
Dim sIndent As String
Dim calcNetChanges As Scripting.Dictionary
Dim calcPctChanges As Scripting.Dictionary
Dim varItem As Variant
Set calculations = dataItem("calculations")
sIndent = String(4, " ")
Set calcNetChanges = calculations("net_changes")
Debug.Print Year & ", " & Period & " (" & periodName & ") - Net Changes:"
If calcNetChanges.Count > 0 Then
For Each varItem In calcNetChanges.keys
Debug.Print sIndent & CStr(varItem) & ": " & calcNetChanges.Item(varItem)
Next varItem
Else
Debug.Print sIndent & "(none)"
End If
Set calcPctChanges = calculations("pct_changes")
Debug.Print Year & ", " & Period & " (" & periodName & ") - Pct Changes:"
If calcPctChanges.Count > 0 Then
For Each varItem In calcPctChanges.keys
Debug.Print sIndent & CStr(varItem) & ": " & calcPctChanges.Item(varItem)
Next varItem
Else
Debug.Print sIndent & "(none)"
End If
which, with the json data provided, should output something like this:
2014, M12 (December) - Net Changes:
(none)
2014, M12 (December) - Pct Changes:
1: 0.0
3: 0.1
6: 0.0
12: -0.7
2014, M11 (November) - Net Changes:
(none)
2014, M11 (November) - Pct Changes:
1: 0.1
3: -0.4
6: 0.0
12: -0.7
If you want to access the items of calculations.net_changes and calculations.pct_changes directly by their keys (known in advance), you would replace the two For Each varItem blocks by, respectively:
If calcNetChanges.Exists("1") Then Debug.Print "1: " & calcNetChanges.Item("1")
If calcNetChanges.Exists("3") Then Debug.Print "3: " & calcNetChanges.Item("3")
If calcNetChanges.Exists("6") Then Debug.Print "6: " & calcNetChanges.Item("6")
If calcNetChanges.Exists("12") Then Debug.Print "12: " & calcNetChanges.Item("12")
[..]
If calcPctChanges.Exists("1") Then Debug.Print "1: " & calcPctChanges.Item("1")
If calcPctChanges.Exists("3") Then Debug.Print "3: " & calcPctChanges.Item("3")
If calcPctChanges.Exists("6") Then Debug.Print "6: " & calcPctChanges.Item("6")
If calcPctChanges.Exists("12") Then Debug.Print "12: " & calcPctChanges.Item("12")
Finally, you should note that in the json data you're giving as the example, percentages (i.e. values of items for [..].calculations.net_changes & [..].calculations.pct_changes) are provided as strings, therefore you would probably want to convert those in Double (or Single) data using Val() to perform math or other numerical operations on them, e.g.:
Dim pctChange_1 As Double, pctChange_3 As Double
Dim pctChange_6 As Double, pctChange_12 As Double
pctChange_1 = 0#
pctChange_3 = 0#
pctChange_6 = 0#
pctChange_12 = 0#
If calcPctChanges.Exists("1") Then pctChange_1 = CDbl(Val(calcPctChanges.Item("1")))
If calcPctChanges.Exists("3") Then pctChange_3 = CDbl(Val(calcPctChanges.Item("3")))
If calcPctChanges.Exists("6") Then pctChange_6 = CDbl(Val(calcPctChanges.Item("6")))
If calcPctChanges.Exists("12") Then pctChange_12 = CDbl(Val(calcPctChanges.Item("12")))
Declare calculations as a Scripting.Dictionary and its pct-changes as Scripting.Dictionary as well. Append the following code snippet after the code for footnotes. HTH
Dim calculations As Scripting.Dictionary
Set calculations = dataItem("calculations")
Dim pct_changes As Scripting.Dictionary
Set pct_changes = calculations("pct_changes")
Dim pct_change As Variant
For Each pct_change In pct_changes
Debug.Print pct_change & ":" & pct_changes(pct_change)
Next pct_change
The Debug.Print pct_change & ":" & pct_changes(pct_change) produces the following result for the first calculations set:
1:0.0
3:0.1
6:0.0
12:-0.7

How to select the file whose name includes the newest date?

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