Im attempting to create a vba function to parse strings of text line by line into an excel table. I'd like the function to only print sub-strings that are between two characters in each line. For example, html tags. While debugging, the Right() function does what I'd like. But the Left() function will not even compile. The error message is very little help, "Invalid procedure call or argument". What is going on? I didn't change that line of code at all and it was just working.
to explain what im trying to accomplish, lets say i'm parsing html text. Id like to only view text inside the "<" and ">" tags. but I'm also trying to code it so I could use this to parse substrings between any two desired characters.
so text like this:
<html>
<head>
</head>
<body>
</body>
</html>
will print:
html
head
/head
body
/body
/html
It was just working. Not sure why I'm getting this error. Only for the Left() trim.
Sub ParseTextFromFile()
Dim myFileName As String
Dim myLine As String
Dim FileNum As Long
Dim n As Integer
n = 1
myFileName = "C:\Users\user\Desktop\myfile.TXT"
FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
Do While Not EOF(FileNum)
Line Input #FileNum, myLine
'Debug.Print TrimString(CStr(myLine))
Cells(n, 1).Value = TrimString(CStr(myLine))
n = n + 1
Loop
MsgBox "" & n - 1 & " items added."
End Sub
'parses a string between two chars/string key values
Function TrimString(s As String) As String
Dim indexOfKey As Integer
Dim firstTrim As String
Dim secondTrim As String
Dim textLength As Integer
Dim key1 As String
Dim key2 As String
firstTrim = ""
secondTrim = ""
key1 = CStr(Cells(5, 8)) 'H5 = "<"
key2 = CStr(Cells(6, 8)) 'H6 = ">"
'remove everything to the left of the first appearance of the key char/string
indexOfKey = InStr(1, s, key1)
firstTrim = Right(s, Len(s) - indexOfKey)
'remove everything to the right of the second appearance of the key char/string
indexOfKey = InStr(1, firstTrim, key2)
secondTrim = Left(firstTrim, indexOfKey - 1) 'this line is throwing the error
TrimString = secondTrim
End Function
Related
Is it some function which can return me text between qoutes.? Text before and between quotes is variable length. I find a function mid but in specify is length. I would like to get from this string text between both quots(APP_STATUS_RUNNING) and (PRIMARY):
string: Error gim_icon_cfg_1 Application with DBID 736 has status "APP_STATUS_RUNNING", runmode "PRIMARY"
Thank you
EDIT: I try to get output to the label but show me error:BC30452: Operator '&' is not defined for types 'String' and '1-dimensional array of String'.
Dim output As String = myProcess.StandardOutput.ReadToEnd()
Dim StandardError As String = myProcess.StandardError.ReadToEnd()
Dim Splitted() As String
Splitted = Split(output, """")
Label1.text="Ahoj " & Splitted & "Error " & StandardError
You can split your string by quotes beeing the delimiter Split(InputString, """") the odd numbers of the output array then are the strings between quotes, the even numbers are the rest.
Option Explicit
Public Sub Example()
Dim InputString As String
InputString = "Error gim_icon_cfg_1 Application with DBID 736 has status ""APP_STATUS_RUNNING"", runmode ""PRIMARY"""
Dim Splitted() As String
Splitted = Split(InputString, """")
' between quotes (all odd numbers)
Debug.Print Splitted(1) ' APP_STATUS_RUNNING
Debug.Print Splitted(3) ' PRIMARY
' rest (all even numbers)
Debug.Print Splitted(0) ' Error gim_icon_cfg_1 Application with DBID 736 has status
Debug.Print Splitted(2) ' , runmode
End Sub
Or:
The follow code gives you what you are trying to have.
In practice you can search patterns that are between quotes then get from each element the first element sliced by quote (which means quote = 0 element = 1 other quote = 2)
Dim s As String = "Error gim_icon_cfg_1 Application With DBID 736 has status ""APP_STATUS_RUNNING"", runmode ""PRIMARY"""
Dim parts() As String = s.Split(" "c).Where(Function(el) el Like "*""*""*").Select(Function(el) el.Split(""""c)(1)).ToArray
I have a VBA code that's designed to search a CSV String and add Carriage Returns where they should exist. I've split it up into two seperate functions - one to search the string and put the index of where the CRs should go into an array and a second function to actually add the CRs.
The issue I'm running into is that the value in the immediate window/in the watch window for the functions is correct within the function itself, but it assigns the result variable a blank string.
'*****************Import CSV**********************
'Took this straight off the internet because it was reading Jet.com files as one single line
'
Sub ImportCSVFile(filepath As String)
.....
line = SearchString(line, "SALE")
.....
End Sub
'****************Search String***************************
'This is search the string for something - It will then call a function to insert carriage returns
Function SearchString(source As String, target As String) As String
Dim i As Integer
Dim k As Integer
Dim myArray() As Variant
Dim resultString As String
Do
i = i + 1
If Mid(source, i, Len(target)) = target Then
ReDim Preserve myArray(k)
myArray(k) = i
k = k + 1
End If
DoEvents
Loop Until i = Len(source)
resultString = addCarriageReturns(source, myArray) 'resultString here is assigned a blank string
SearchString = resultString
End Function
'***************Add Carraige Returns**************************
'Cycle through the indices held in the array and place carriage returns into the string
Function addCarriageReturns(source As String, myArray As Variant) As String
Dim i As Integer
Dim resultString As String
resultString = source
For i = 0 To UBound(myArray, 1)
resultString = Left(resultString, myArray(i) + i) & Chr(13) & Right(resultString, Len(resultString) - myArray(i) + i)
Next i
addCarraigeReturns = resultString 'The value of addCarriageReturn is correct in the immediate window here
End Function
In the function the value is not blank
...but when it passes it back, it says the value is blank
I'm just curious, why do you want separate functions like this?
Can you just use:
line = Replace(line, "SALE", "SALE" & Chr(13))
This is the output of a program.
I have specified what shall be width of each cell in the program and my program shows correct output.
What I want to do is cell content shall be written from right to left. E.g highlighted figure 9983.54 has width of 21. Text file has used first 7 columns. But I want it to use last 7 columns of text file.
Please see expected output image.
I am not getting any clue how to do this. I am not a very professional programmer but I love coding. This text file is used as input to some other program and i am trying to automate writing text file from excel VBA.
Can anyone suggest a way to get this output format?
Here is the code which gave me first output
Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
Dim i As Long, j As Long
Dim strLine As String, strCell As String
'get a freefile
Dim fNum As Long
fNum = FreeFile
'open the textfile
Open strFile For Output As fNum
'loop from first to last row
'use 2 rather than 1 to ignore header row
For i = 1 To ws.Range("a65536").End(xlUp).Row
'new line
strLine = ""
'loop through each field
For j = 0 To UBound(s)
'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
'add on string of spaces with length equal to the difference in length between field length and value length
strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
Next j
'write the line to the file
Print #fNum, strLine
Next i
'close the file
Close #fNum
End Sub
'for example the code could be called using:
Sub CreateFile()
Dim sPath As String
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If LCase$(sPath) = "false" Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below +1
Dim s(6) As Integer
'starting at 0 specify the width of each column
s(0) = 21
s(1) = 9
s(2) = 15
s(3) = 11
s(4) = 12
s(5) = 10
s(6) = 186
'for example to use 3 columns with field of length 5, 10 and 15 you would use:
'dim s(2) as Integer
's(0)=5
's(1)=10
's(2)=15
'write to file the data from the activesheet
CreateFixedWidthFile sPath, ActiveSheet, s
End Sub
Something like this should work:
x = 9983.54
a = Space(21-Len(CStr(x))) & CStr(x)
Then a will be 14 spaces followed by x:
a = " 9983.54"
Here 21 is the desired column width --- change as necessary. CStr may be unnecessary for non-numeric x.
If you're going to right-justify a lot of different data to different width fields you could write a general purpose function:
Function LeftJust(val As String, width As Integer) As String
LeftJust = Space(width - Len(val)) & val
End Function
The you call it with LeftJust(CStr(9983.54), 21).
Also note that VBA's Print # statement has a Spc(n) parameter that you can use to produce fixed-width output, e.g., Print #fNum, Spc(n); a; before this statement you calculate n: n = 21-Len(CStr(a)).
Hope that helps
I'm rooky for VBA. I have some problem about reversing my data on VBA-Excel. My data is "3>8 , 6>15 , 26>41 (each data on difference cells)" that i could reverse "3>8" to "8>3" follow my requirement by using function reverse. But i couldn't reverse "6>15" and "26>41" to "15>6" and "41>26". It will be "51>6" and "14>62" that failure, I want to be "15>6" and "41>26".
Reverse = StrReverse(Trim(str))
Help me for solve my issue please and thank for comment.
You first need to find the position of the ">" in the cell. you do this by taking the contents of the cell and treating it as a String and finding the ">"
This is done in the line beginning arrowPosition. This is the integer value of the position of the ">" in you original string
Next use Left to extract the text up to the ">" and Right to extract the text after the ">"
Then build a new String of rightstr & ">" & leftStr.
Note I input my data from Sheet1 B5 but you can just use any source as long as it is a String in the correct format.
Sub Test()
Dim myString As String
myString = Sheets("Sheet1").Range("B5")
Debug.Print myString
Debug.Print reverseString(myString)
End Sub
Function reverseString(inputString As String) As String
Dim leftStr As String
Dim rightStr As String
Dim arrowPosition As Integer
arrowPosition = InStr(1, inputString, ">")
leftStr = Left(inputString, arrowPosition - 1)
rightStr = Right(inputString, Len(inputString) - arrowPosition)
reverseString = rightStr & ">" & leftStr
End Function
just because you look for a VBA, you can add this function into your code:
Function rev(t As String) As String
s = Split(t, ">", 2)
rev = s(1) & ">" & s(0)
End Function
of course only if you have to reverse 2 number, otherwise you'll loop the "s", but the function would lose its usefulness
I use Excel VBA and the following method to search a string in html files, and replace it with the same string after adding bold tag.
FindAndReplace ("C:\xxx.htm", "hello world", "<b>hello world</b>")
Private Sub FindAndReplace(filePath As String, findWhat As String, replaceWith As String)
Dim nextFileNum As Long
Dim oldFileContents As String
Dim newFileContents As String
Dim textFileTypes() As String
Dim fileExtension As String
Dim sFileName As String
Dim iFileNum As Integer
Dim sBuf As String
Dim strFound As Integer
If Len(Dir(filePath)) = 0 Then
Exit Sub
End If
nextFileNum = FreeFile
Open filePath For Input As #nextFileNum
oldFileContents = Input$(LOF(nextFileNum), #nextFileNum)
Close #nextFileNum
newFileContents = Replace(oldFileContents, findWhat, replaceWith)
nextFileNum = FreeFile
Open filePath For Output As #nextFileNum
Print #nextFileNum, newFileContents
Close #nextFileNum
End Sub
The problem I am facing is the function won;t find the string if it splits in between because of the html source code line break.
For example, the string is found if the code is:
<p>hi hola hello world</p>
but it is not found if the code is:
<p>hi hola hello
world</p>
Is there any other VBA method that I can use to search and replace text, or some functionality can be added to the above code so that it ignores the line break in between.
Try using a variation of:
Function RemoveCarriageReturns(SourceString As String) As String
Dim s As String
'strip out CR and LF characters together
s = Replace(SourceString, vbCrLf, "")
'just in case, remove them one at a time
s = Replace(s, Chr(13), "")
s = Replace(s, Chr(10), "")
RemoveCarriageReturns = s
End Function
The ASCII characters 13 and 10 are the carriage return and line feed characters.
If the split is only with linefeeds/returns (Chr(10), Chr(13)) and/or spaces Chr(32) then you might just search for "hello" first.
When found look for those characters (10, 13 and 32) and skip over them until you run into something else (use a DO WHILE ... OR ... OR ... OR loop).
Now check if that something else would be "world" and at least 1 of these characters was encountered.
In that case you will change "hello" into "<b>hello" and "world" into "world</b>"