I am trying to use VBA build a .jet file, but when I try to append, two possible problems appear. Either it includes all double quotes including the double double quotes like you would normally do in, say, a msgbox, or the string wont work if i remove the double double quotes because the first instance of quotes terminates the string. An example of my code is below (note, the commented/indented areas in the main sub are various possibilities I have tried but without success:
Sheets("Sheet1").Range("A1").Select
Dim MyStr As String
'MyStr = "{" & Chr(34) & "myid" & Chr(34) & ":345," & Chr(34) & "content" & Chr(34) & ":["
'MyStr = "{""myid"":345,""content"":["
'appendToFile ("{""myid"":345,""content"":[")
'appendToFile (MyStr)
End Sub
Sub appendToFile(MyStr As String)
Dim fileName As String
fileName = "MyFile.jet"
Open Application.ActiveWorkbook.Path & "\" & fileName For Append As #1
Write #1, MyStr
Close #1
End Sub
If you want to avoid the extra quotes appearing in your .jet, you can append using the Print # statement, and not the Write # statement.
Unlike the Print # statement, the Write # statement inserts commas between items and quotation marks around strings as they are written to the file.
For example, this code:
Option Explicit
Sub ject()
Dim MyStr As String
MyStr = "{" & Chr(34) & "myid" & Chr(34) & ":345," & Chr(34) & "content" & Chr(34) & ":["
appendToFile (MyStr)
End Sub
Sub appendToFile(MyStr As String)
Dim fileName As String
fileName = "MyFile.jet"
Open Application.ActiveWorkbook.path & "\" & fileName For Append As #1
Print #1,
Close #1
End Sub
will result in:
{"myid":345,"content":[
when opening the .jet file with a text editor.
Is that what you want?
Related
I was trying to use the code from the following post to determine whether a different excel file is open:
Detect whether Excel workbook is already open
but my code was errorring out every time. After a bit of testing, I determined it appears to be because I have spaces in the filename/path. Is there a way to allow for the file path to include spaces?
You need to wrap the whole path and filename in double quotes if you have spaces in your file name.
So if you have a vba path & file name of:
WBPath = WB.Path & Application.PathSeparator & WBName
You need to add double quotes to the beginning and end of the string.
WBPath = """" & WB.Path & Application.PathSeparator & WBName & """"
What is """"? (The string starts with a " then the next two " " resolve to be a single double quote of text, then the last " ends the string.)
So you are in essence concatenating a Double Quote to the front of the path\file name and to the end.
Hope that helps. :)
This question already has answers here:
How do I put double quotes in a string in vba?
(5 answers)
Closed 4 years ago.
I have a variable for the string tag:some text that is stored in a cell. How can I modify the string that is stored in the variable so that it is interpreted as tag:\"some text\" (retaining the escape characters)?
Solution: s = Left(s, 4) & "\" & Chr(34) & Right(s, Len(s) - 4) & Chr(34)
use chr(34) to append the quote to the string
dim s as string
s = "tag:\" & Chr(34) & "some text\" & Chr(34)
I am not completely understanding the question, but it seems that you are trying to make a string "some text" into "\"some text\""? If so, you can use CHR(34) as the double quotes. so it would look like
"\" & CHR(34) & "some text\" & CHR(34)
Double Quotes are escaped by adding an extra Double Quotes or using Chr(34), the ascii char number for a Double Quote.
I usually build my strings in the Immediate Window
"tag:""some text"""
"tag:" & Chr(34) & "some text" & Chr(34)
If I have to escape many double quotes copy the string to the Clipboard and process it there:
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard
.SetText Replace(.GetText, Chr(34), String(2, 34))
.PutInClipboard
End With
I have three String varibales in my VBA code as below:
Dim FilePath As String
Dim FooterFilePath As String
Dim PlusChar As String
FilePath = Application.ActiveWorkbook.Path & "\Bin\file.txt"
FooterFilePath = Application.ActiveWorkbook.Path & "\Bin\footer.txt"
PlusChar = Chr(43) 'i.e. "+" sign
Now I am trying to merge FilePath and FooterFilePath and write the combined result in FilePath again i.e. overwriting it. For that I am using followng line which doesn't work:
Shell "cmd.exe copy /c & FilePath & PlusChar & FooterFilePath & FilePath", 0
I know I have syntaxing issue here but I just don't know how to pass three variables into Shell command.
You have to put the variables outside the enclosing double-quotes. also you should insert blanks between the different names so that your command does not get the names combined in one name. Try this:
Shell "cmd.exe copy /c " & FilePath & " " & PlusChar & " " & FooterFilePath & " " & FilePath, 0
But:
There's no reason to have a variable for the +
Your drive's name is missing in the paths
/C is an option for the cmd program, not for the copy command.
It is useful to print that expression in the immediate window to verify it before execution. To do so, you can put it in a String variable and debug.print it before execution:
This would be correct:
Dim FilePath As String, FooterFilePath As String, myCommand As String
FilePath = Application.ActiveWorkbook.Path & "C:\Bin\file.txt"
FooterFilePath = Application.ActiveWorkbook.Path & "C:\Bin\footer.txt"
myCommand = "cmd /c copy " & FilePath & " + " & FooterFilePath & " " & FilePath
Debug.Print myCommand
Shell myCommand, 0
I need to save a copy of the worksheet I'm using as a CSV file.
The save name is to be the date and the user's name. I set up variables to get this information.
I get
Run-time error '1004'; Application-defined or object-defined error
on the line
Activeworkbook.saveAs Filename
Code is:
Sub SaveCSV()
rundate = DateTime.Now
runname = Application.UserName
savename = rundate & runname
sfilename = ActiveWorkbook.Path & "\" & savename & ".csv"
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=sfilename, FileFormat:=xlCSV
Application.DisplayAlerts = True
End Sub
Value of rundate (based on default regional settings) will be something similar to below:
3/12/2019 10:25:11
of which forward slash (/) & colon (:) are illegal characters as per the file name conventions in Windows.
To resolve this specific issue, use the below code to assign current-time to the rundate variable:
rundate = Format(DateTime.Now, "dd-MMM-YYYY_hh-mm-ss_")
Another good way is to use generic function because we don't always know what illegal characters are creating the trouble. Because there could be more illegal characters in the filename. Above approach is correct but it's not comprehensive list of illegal characters to remove or replace from the filename before saving it. For eg. these characters are missing from the array in your code -> : & . However it is advised to keep filename rid of other allowed special characters too.
Below, I am providing the function which returns a safe string that can be used to produce filename before saving.
Function ReplaceIllegalCharacters(strIn As String, strChar As String) As String
Dim strSpecialChars As String
Dim i As Long
strSpecialChars = "~""#%&*:<>?{|}/\[]" & Chr(10) & Chr(13)
For i = 1 To Len(strSpecialChars)
strIn = Replace(strIn , Mid$(strSpecialChars, i, 1), strChar)
Next
ReplaceIllegalCharacters = strIn
End Function
Specifically, in your code, replace the ActiveWorkbook.SaveAs line with this line:
ActiveWorkbook.SaveAs Filename:= ReplaceIllegalCharacters(sfilename, "_") & _
, FileFormat:=xlCSV, CreateBackup:=False
So, I have Googled about and it seems that while making custom Pop up menus, if one wants to pass parameters then this is possible but for me comes with 2 major problems:
1) The function you call will execute, but you will not be able to activate a breakpoint on it, or even use Stop.
2) Oddly it seems to get called twice, which isn't very helpful either.
Code to illustrate ( please put in a module and not in a sheet )
Option Explicit
Sub AssignIt()
Dim cbrCmdBar As CommandBar
Dim strCBarName As String
On Error Resume Next
strCBarName = "MyNewPopupMenu"
'Delete it first so multiple runs can occur without appending
Application.CommandBars(strCBarName).Delete
' Create a menu bar.
Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarMenuBar)
' Create a pop-up menu.
strCBarName = "MyNewPopupMenu"
Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)
'DEFINE COMMAND BAR CONTROL
With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
.Caption = "MyMenu"
.OnAction = BuildProcArgString("MyProc", "A", "B", "C") 'You can add any number of arguments here!
End With
'DEFINE COMMAND BAR CONTROL
With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
.Caption = "Test No Args"
.OnAction = "CallWithNoArgs"
End With
Application.CommandBars(strCBarName).ShowPopup
End Sub
Sub CallWithNoArgs()
MsgBox "No Args"
End Sub
'FUNCTION TO BUILD PROCEDURE ARGUMENTS (You just have to plop this in any of your modules)
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)
Dim TempArg
Dim Temp
For Each TempArg In Args
Temp = Temp + Chr(34) + TempArg + Chr(34) + ","
Next
BuildProcArgString = ProcName + "(" + Left(Temp, Len(Temp) - 1) + ")"
End Function
'AND FINALLY - THE EXECUTABLE PROCEDURE!
Sub MyProc(x, y, z)
MsgBox x & y & z
Debug.Print "arrgggh why won't the breakpoint work, and why call twice!!!!!!"
End Sub
If someone could help with this, that would be great. It seems another developer in the past hit the wall and so for the 5 items we have Method_1 ... Method_5 with the number passed into Method_Core(ByVal i As Integer) style. I think I will take this route too although very ugly, it works better than what I have mocked up below.
PS. This is a quick mockup so I don't expose proprietary code etc
You can use the .Parameter property. This is an example of a code in production (with only the lines of interest):
Dim i As Integer
Set cl = MainForm.Controls("classroomList")
For i = 0 To cl.ListCount - 1
With .Controls.Add(Type:=msoControlButton)
.Caption = cl.List(i)
.faceId = 177
.OnAction = "'" & ThisWorkbook.Name & "'!" & "assignClassroom"
.Parameter = cl.List(i)
End With
Next i
And the procedure could be something like:
Public Sub assignClassroom(Optional someArg as SomeType)
' code here
CommandBars.ActionControl.Parameter 'The parameter here
' more code here
End Sub
Don't ask me why this works, but it does. Source for this info is Using procedures with arguments in non-obvious instances
Sub AssignIt()
Const strCBarName As String = "MyNewPopupMenu"
Dim cbrCmdBar As CommandBar
'Delete it first so multiple runs can occur without appending
On Error Resume Next
Application.CommandBars(strCBarName).Delete
On Error GoTo 0
' Create a pop-up menu.
Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)
'DEFINE COMMAND BAR CONTROL
With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
.Caption = "MyMenu"
.OnAction = "'MyProc ""A"",""B"",2'"
End With
Application.CommandBars(strCBarName).ShowPopup
End Sub
Sub MyProc(x As String, y As String, z As Integer)
MsgBox x & y & (z * 2)
Debug.Print "AHA!!! the breakpoint works, and it's only called once!!!!!!"
End Sub
The key is to call the procedure in the .OnAction event surrounded by single quotes. Also, you need to escape your double quotes with double quotes. Numeric parameters need not be escaped.
The reason there are double calls and no break points is because of the parentheses (“( )”) surrounding the arguments in the .OnAction call:
.OnAction = BuildProcArgString("MyProc", "A", "B", "C")
Best guess: The parser for .OnAction chokes when these parentheses are used.
This should work:
.OnAction = "'BuildProcArgString" & chr(34) & "MyProc" & _
chr(34) & "," & chr(34) & "A" & chr(34) & "," & chr(34) & _
"B" & chr(34) & "," & chr(34) & "C" & "'"
Other Notes:
1) Single quotes, after the first double quote and before the last double quote, should be used to encapsulate the entire call.
2) Chr(34) is the ASCII character for double quotes (“). All data types (ints, longs, strings, etc.), and quoted commas need to be preceeded by a Chr(34). The one exception is the ending sinlge quote (" ' "). Example:
.OnAction = "'m_Test" & Chr(34) & 100 & Chr(34) & "," & Chr(34) & _
intVariable & Chr(34) & "," & Chr(34) & "String" & Chr(34) & _
"," & Chr(34) & stringVariable & "'"
The function called:
Public Function m_Test(i as Integer, iVar as Integer, s as String, sVar as String)
3) .OnAction does not seem to pass Arrays or Objects. An item in an array can be passed (e.g. .OnAction = "'myTest" & Chr (34) & Args(0) & "'"), but not the entire Array (e.g. .OnAction = "'myTest" & Chr (34) & Args & "'"). Object pointers can be passed (ref: http://www.access-programmers.co.uk/forums/showthread.php?t=225415). But I've had no success in passing pointers to arrays.
4) The .OnAction used in the original example is not surrounded by quotation marks so the .OnAction call is made when AssignIt() gets called but before the popup menu pops up.