I'm attempting to run an exe via command line that requires a JSON string as an argument. Inside that JSON string are dynamic start/end date variables, and a file name variable.
I'm able to run the command with the Shell function, however I need the waitTillComplete functionality of WScript.Shell.
This is how the string looks when I pass it to Call Shell() {which runs successfully}
C:\Users\API\Client.exe /api/v2/ro/my/deposits {\"startDateInOut\":\"2022-09-30\",\"enddate\":\"2022-10-08\"} deposit-2022-09-30_2022-10-08.JSON
After much searching I still cannot for the life of me figure out how to structure this so shell.Run() will accept it.
Here is what I've got so far:
Sub test()
Dim shell As Object
Set shell = VBA.CreateObject("WScript.Shell")
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim style As Integer: style = 1
Dim errorcode As Integer
Dim path As String
startDateInOut = "2022-10-01"
EndDate = "2022-10-10"
client = "C:\Users\API\Client.exe"
arg_1 = "/api/v2/ro/my/deposits {\""startdate\"":\" & """" & startDateInOut & "\""" & ",\""enddate\"":\" & """" & EndDate & "\""}" & " " & "test.json"
path = Chr(34) & client & Chr(34) & " " & Chr(34) & arg_1 & Chr(34)
Debug.Print path
goClient = shell.Run(path, style, waitTillComplete)
End Sub
If possible I would like to avoid using a batch file and keep everything inside of the vba module.
Any help would be greatly appreciated!
Related
I want to export a query as a text file from an access database but using vba. The issue is I need to save it with .ail2 in the name.
basically I want it of the form: "currentdate_version.ail2".txt (the quotations are very important otherwise it won't work).
So for example todays first version would look like:
"20182910_1.ail2".txt
I have tried exporting it manually and saving it as this but the export wizard doesn't seem to like the quotation marks in the saved name. I have therefore been exporting it (using a custom saved export that i've labelled test1 - it includes the headers of each column, sets the text qualifier as 'none', the field delimiter as 'tab' and file format is 'delimited').
I am using the following code in access, the first part just makes sure the folder with the current date exists.
Private Sub ExportExcel()
Dim myQueryName As String
Dim myExportFileName As String
Dim strSheets As String
Dim sFolderPath As String
Dim filename As Variant
Dim i As Integer
strSheets = Format(Date, "yyyymmdd")
sFolderPath = "M:\AIL2Files\" & strSheets & ""
Dim fdObj As Object
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("" & sFolderPath & "") Then
Else
fdObj.CreateFolder ("" & sFolderPath & "")
End If
i = 1
filename = Dir(sFolderPath & "\*" & i & ".txt")
Do While Len(filename) > 0
filename = Dir(sFolderPath & "\*" & i & ".txt")
i = i + 1
Loop
myQueryName = "001_querytest"
myExportFileName = "" & sFolderPath & "\" & Chr(34) & "" & strSheets & "_" & i & ".ail2" & Chr(34) & ".txt"
DoCmd.TransferText acExportDelim, "test1", myQueryName, myExportFileName, True
End Sub
test1 isn't being picked up even though its a 'saved export'. I assume I'm doing this part wrong... but even still I reckon the save won't be successful and will not include the quotation marks.
Thanks.
EDIT:
I have tried doing the following instead:
DoCmd.TransferText transferType:=acExportDelim, TableName:=myQueryName, filename:=myExportFileName, hasfieldnames:=True
It now saves, but again not including the quotation marks as desired. Whats interesting is when I type ?myExportFileName in the immediate window, it displays my desired filename but the command is clearly not working correctly as I get it of the form:
_20181029_1#ail2_
Instead...
Here is image if I use save as:
I end up getting:
There are some misconceptions here.
Windows file names cannot contain double quotes ", period. And you don't need them, either. Just save your file as filename.ail2.
This is what you get when doing "Save as". Tell Explorer to show file extensions, and you'll see that you don't have "filename.ail2".txt but filename.ail2.
You only need
myExportFileName = sFolderPath & "\" & strSheets & "_" & i & ".ail2"
test1 isn't being picked up even though its a 'saved export'.
DoCmd.TransferText doesn't use saved exports, but export specifications. See here for the difference:
Can I programmatically get at all Import/Export Specs in MS Access 2010?
Addendum
DoCmd.TransferText could throw a runtime error when given an illegal file name, but apparently it tries to save the day by exchanging the illegal characters by _, hence _20181029_1#ail2_ (.txt)
A workaround to this is first saving the file as a .txt using DoCmd.TransferText, but running a shell and renaming. Like such:
myExportFileName = sFolderPath & "\" & strSheets & "_" & i & ".txt"
DoCmd.TransferText TransferType:=acExportDelim, SpecificationName:="034_AILFILE Export Specification", TableName:=myQueryName, filename:=myExportFileName, HasFieldnames:=True
Set wshShell = CreateObject("Wscript.Shell")
strDocuments = wshShell.SpecialFolders("M:\AIL2Files\" & strSheets & "")
oldFileName = myExportFileName
newFileName = sFolderPath & "\" & strSheets & "_" & i & ".ail2"
Name oldFileName As newFileName
There is undoubtedly cleaner ways of doing this but I imagine that this method could be used to save any files that have non traditional extensions, but fundamentally follow the format of a .txt file.
I am writing some VBA in MS Access, although the principle of my question would apply just as well to Excel or Word VBA. I have written a function GetStringParameterFromTable which returns a string value. It is possible that the function may result in a VBA-generated error, despite my best efforts to write it so that it does not. If an error happens, I don't want the code to crash, so I must use error handling. However, I don't want the code to display an error message and stop within the function if there is an error. I want the function to finish executing and return control to the calling procedure, and then I want the calling procedure to display the error message and tidy up, e.g. close open files. My question is: how does the calling procedure know that there has been an error in the function it called, and how does it get the error message?
I have thought of three ways of implementing this:
(1) Make GetStringParameterFromTable into a Sub, and pass it ParameterValue, ErrorFlag and ErrorMessage by reference.
(2) Keep GetStringParameterFromTable as a Function, define ErrorFlag and ErrorMessage as global variables and have the function alter ErrorFlag and ErrorMessage.
(3) Keep GetStringParameterFromTable as a Function and define a type with three components – ParameterValue, ErrorFlag and ErrorMessage – and make GetStringParameterFromTable return a value of the type I have defined.
I think that my requirement must be quite common, but I can’t find any examples of how it’s implemented. Does anyone have any views on which of my suggestions is the best way, or whether there is a better way that I haven’t thought of?
I have been contemplating the same thing since C#.net has implemented Tuples. I have implemented Tuples using VBA's type to create my tuples. What I have done is the following:
Public Type myTuple
Value as String 'Or whatever type your value needs to be
ErrCode as Long
ErrDesc as String
End Type
Public Function DoWork (ByRef mObject as MyClass) as myTuple
Dim retVal as myTuple
'Do whatever work
If Err.Number <> 0 then
retVal.Value = Nothing
retVal.ErrNumber = Err.Number
retVal.ErrDesc = Err.Description
Else
Set retVal.Value = Whatever Makes Sense
retVal.ErrNumber = 0
retVal.ErrDesc = VbNullString
End If
DoWork = retVal
End Function
I would like to be more specific, but you didn't provide a code example.
I am doing it like this and log the errors in a table:
' Lookups Replacements
'---------------------
Function DLook(Expression As String, Domain As String, Optional Criteria) As Variant
On Error GoTo Err_Handler
Dim strSQL As String
strSQL = "SELECT " & Expression & " FROM " & Domain 'DLookup
'DCount: strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain
'DMax: strSQL = "SELECT MAX(" & Expression & ") FROM " & Domain
'DMin: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DFirst: strSQL = "SELECT FIRST(" & Expression & ") FROM " & Domain
'DLast: strSQL = "SELECT LAST(" & Expression & ") FROM " & Domain
'DSum: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DAvg: strSQL = "SELECT AVG(" & Expression & ") FROM " & Domain
If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria
DLook = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
Exit Function
Err_Handler:
'Can be made as Error Sub as well
Dim ErrNumber as Integer
Dim ErrDescription as String
ErrNumber = Err.Number
ErrDescription = Err.Description
Err.Clear
On Error Resume Next
Dim strSQL as String
strSQL = "INSERT INTO tblErrorLog (ErrorNumber, ErrorDescription) VALUES (" & ErrNumber & ", '" & ErrDescription & "')"
Currentdb.Excecute strSQL, dbFailOnError
End Function
Called with:
If DLook("Column2", "Table1", "Column1 = " & ID) = 0 Then
'Do stuff
End If
If DLook("Column2", "Table1") = 0 Then
'Do other stuff
End If
I'm trying to change my application so that it outputs JSON instead of HTML when it makes an AJAX request for some data. I have an ADODB RecordSet. I need to loop through it row-by-row and add/change/remove different values. Then I need to take all the modified rows and response.write them as JSON. I'm using JSON2.asp so my application already supports JSON.parse & JSON.stringify but I can't get it to spit out the multi-dimensional array as JSON.
set rs = conn.execute(strQuery)
if Not rs.EOF Then
rsArray = rs.GetRows() 'This pulls in all the results of the RecordSet as a 2-dimensional array
columnCount = ubound(rsArray,1)
rowCount = ubound(rsArray,2)
For rowIndex = 0 to rowCount 'Loop through rows as the outer loop
rsArray(3,0) = "somethingelse"
Next 'Move on to next row if there is one
response.write JSON.stringify(rsArray) & " _______ "
End If
I just need to be able to go through the results of my database query, modify the results, and then output the modified results in JSON format. What's the right way to do this?
The JSON2.asp implementation doesn't have a "Load From Database" function which means you will have to implement something to convert the ADODB.Recordset to a JSON structure yourself.
If you are willing to use a different script there is an implementation by RCDMK on GitHub that does have a LoadRecordset() method, it's called JSON object class 3.5.3.
This makes loading data from an ADODB.Recordset really straightforward.
<!-- #include virtual="/jsonObject.class.asp" -->
<%
Response.LCID = 2057
'...
Dim rs: Set rs = conn.execute(strQuery)
Dim JSON: Set JSON = New JSONobject
Call JSON.LoadRecordset(rs)
Call Response.Clear()
Response.ContentType = "application/json"
Call JSON.Write()
%>
Code has been tested using a disconnected recordset, the ... here denote assumed code to setup your recordset, connection etc
It's worth noting you could write this yourself, it's not a huge leap to loop through an ADODB.Recordset and build a JSON string. However, I would argue against for a few reasons;
It is a time-consuming exercise.
Very easy to miss something (like checking for numeric data types, when generating output).
Depending on how it is coded can make it awkward to maintain (For example, if not injecting property names directly from the recordset and choosing to "hardcode" them instead).
Why reinvent the wheel ? There are a lot of public implementations in the wild that deal with the issues raised here. Admittedly, some are better than others, but it takes five minutes to include them and give it a try.
Just for completeness here is my local test code using a disconnected recordset
<!-- #include virtual="/jsonObject.class.asp" -->
<%
Call init()
Sub init()
Dim fields: fields = Array(Array("title", adVarChar, 50), Array("firstname", adVarChar, 50), Array("lastname", adVarChar, 50), Array("age", adInteger, 4))
Dim rs: Set rs = Server.CreateObject("ADODB.Recordset")
Call InsertRow(rs, fields, Array("Mr", "Joe", "Bloggs", 31))
Call InsertRow(rs, fields, Array("Mr", "John", "Smith", 42))
Response.LCID = 2057
Dim JSON: Set JSON = New JSONobject
Call JSON.LoadRecordset(rs)
Call Response.Clear()
Response.ContentType = "application/json"
Call JSON.Write()
End Sub
Sub InsertRow(ByVal rs, fields, values)
With rs
If rs.State <> adStateOpen Then
For Each fld In fields
Call .Fields.Append(fld(0), fld(1), fld(2))
Next
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
Call .Open()
End If
Call .AddNew()
For i = 0 To UBound(fields, 1)
.Fields(fields(i)(0)).Value = values(i)
Next
Call .Update()
Call .MoveFirst()
End With
End Sub
%>
Output:
{"data":[{"title":"Mr","firstname":"Joe","lastname":"Bloggs","age":31},{"title":"Mr","firstname":"John","lastname":"Smith","age":42}]}
Here ya go. This works for me.
set rs = conn.execute(strQuery)
c=0
Response.write "["
Do Until rs.eof
'Assign variables here with whatever you need to change
title = rs(0)
fName = rs(1)
lName = rs(2)
empID = rs(3)
With Response
if c > 0 then .write ", "
.write "{" & chr(34) & "Title" & chr(34) & " : " & chr(34) & title & chr(34) & ", " & chr(34) & "FirstName" & chr(34) & " : " & chr(34) & fName & chr(34) & ", "
.write chr(34) & "LastName" & chr(34) & " : " & chr(34) & lName & chr(34) & ", " & chr(34) & "EmpID" & chr(34) & " : " & chr(34) & empID & chr(34) & "}"
End With
c = c + 1
rs.MoveNext
Loop
Response.write "]"
This will write your JSON object directly to the page.
try setting content-type to "application/json" on top of your asp page.
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit
Response.Buffer=True
Response.ContentType="application/json"
Response.Charset="utf-8"
'' rest of your code.. your db operations
'' response write your json
%>
I have created a function that provide the value based on user selection.I want to use the output of the fuinction in another query.
My function is :-
Public Function provisionvariable() As String
For Each sItem In Forms![Access Form].Provision.ItemsSelected
v_provision = "" & Forms![Access Form].Provision.Column(0, sItem) & ""
Provision = Provision & "" + v_provision + ","
'MsgBox Provision
Next
Provision = Left(Provision, Len(Provision) - 1)
provisionvariable = Provision
MsgBox provisionvariable
End Function
The output of the function is BBNI,FP
I want to use the output as where condition in access query
My query is
***SELECT DISTINCT quarter, provision, [currencycode]+'-not found in Master' AS Comment
FROM t_00_unearned_unincepted_alloc_basis AS inp
WHERE **provision in (provisionvariable()) AND**
NOT EXISTS
(SELECT 1
FROM t_01_le_currency_master key1
WHERE inp.[group_stat]=key1.[group_stat] AND
inp.le=key1.le AND
inp.[currencycode]=key1.[original_currency]);***
Now the problem is output of function is BBNI,FP but access takes it as single string i.e. 'BBNI,FP' in the query.
Is it possible to have it as two string ('bbni','FP') rather than 'BBNI,FP'
Any Suggestions Much Appreciated
Thanks
Try:
Provision = Provision & "'" & v_provision & "',"
And to ensure you aren't repeatedly appending to a module-level variable, you should also do a local
Dim Provision As String
Based on the following post, "a function cannot be used for IN () clauses" How to call VBA-function from inside sql-query?
So you need to build the SQL (which would include the 'In' list) then execute it. Since I have no idea if multi-user environment, or how you will use the query output, I would build the SQL, save as a QueryDef object, then do whatever you want.
The following is what the code to build the SQL could look like:
Dim strSQL As String
strSQL = "SELECT DISTINCT quarter, provision, [currencycode]+'-not found in Master' AS Comment " & _
"FROM t_00_unearned_unincepted_alloc_basis AS inp " & _
"WHERE provision In (" & ProvisionVariable() & ") AND " & _
. . . .
Debug.Print strSQL
The following is my version of your Function (note the single-quote delimiters are added):
Public Function ProvisionVariable() As String
Dim sItem As Variant
Dim v_provision As String
Dim provision As String
provision = ""
For Each sItem In Forms![Access Form].Provision.ItemsSelected
v_provision = "'" & Forms![Access Form].Provision.Column(0, sItem) & "'"
provision = provision & "" + v_provision + ","
Next sItem
provision = left(provision, Len(provision) - 1)
ProvisionVariable = provision
Debug.Print ProvisionVariable
End Function
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