I have the string of the following format:
example 1: ABC,0,ABCD,ABC,ABC,ABC,ABC,ABC,11,ABC,ABC,toRemove,012,234
example 2: ABC,0,ABCD,ABC,ABC,ABC,ABC,ABC,11,ABC,ABC, toRemove,012,234
If the string contains 14 Values (instead of 13 values) separated by comma, then remove the 12. value
The second line above contains a white space, that should also removed if exists.
StringSplit has already a counter (element 0), so no need to use Ubound).
Like StringSplit converts a string to an array, ArrayToString converts an array back to a string.
#include <array.au3>
$tmp_line = "ABC,0,ABCD,ABC,ABC,ABC,ABC,ABC,11,ABC,ABC, ToRemove,012,234"
$line = StringSplit($tmp_line, ",")
If $line[0] = 14 Then
$new_line = ArrayToString($line, ",", 1, 11) & "," & ArrayToString($line, ",", 13)
Else
$new_line = $line ; shouldn't this be $new_line = $tmp_line ?
EndIf
MsgBox(0, $line[0], $tmp_line & #CRLF & $new_line)
Solved:
$line = StringSplit($tmp_line, ",")
$count_values = Ubound($line)
If $count_values = 14 Then
$new_line = $line[1] & "," & $line[2] & "," & $line[3] & "," & $line[4] & "," & $line[5] & "," & $line[6] & "," & $line[7] & "," & $line[8] & "," & $line[9] & "," & $line[10] & "," & $line[12] & "," & $line[13]
Else
$new_line = $line
EndIf
Related
I need to tokenize a mathematical expression using VBA. I have a working solution but am looking for a more efficient way of doing it (possibly RegExp).
My current solution:
Function TokeniseTheString(str As String) As String()
Dim Operators() As String
' Array of Operators:
Operators = Split("+,-,/,*,^,<=,>=,<,>,=", ",")
' add special characters around all "(", ")" and ","
str = Replace(str, "(", Chr(1) & "(" & Chr(1))
str = Replace(str, ")", Chr(1) & ")" & Chr(1))
str = Replace(str, ",", Chr(1) & "," & Chr(1))
Dim i As Long
' add special characters around all operators
For i = LBound(Operators) To UBound(Operators)
str = Replace(str, Operators(i), Chr(1) & Operators(i) & Chr(1))
Next i
' for <= and >=, there will now be two special characters between them instead of being one token
' to change < = back to <=, for example
For i = LBound(Operators) To UBound(Operators)
If Len(Operators(i)) = 2 Then
str = Replace(str, Left(Operators(i), 1) & Chr(1) & Chr(1) & Right(Operators(i), 1), Operators(i))
End If
Next i
' if there was a "(", ")", "," or operator next to each other, there will be two special characters next to each other
Do While InStr(str, Chr(1) & Chr(1)) > 0
str = Replace(str, Chr(1) & Chr(1), Chr(1))
Loop
' Remove special character at the end of the string:
If Right(str, 1) = Chr(1) Then str = Left(str, Len(str) - 1)
TokeniseTheString = Split(str, Chr(1))
End Function
Test using this string IF(TestValue>=0,TestValue,-TestValue) gives me the desired solution.
Sub test()
Dim TokenArray() As String
TokenArray = TokeniseTheString("IF(TestValue>=0,TestValue,-TestValue)")
End Sub
I have never seen regular expressions before and tried to implement this into VBA. The problem I am having is that the RegExp object in VBA doesn't allow positive lookbehind.
I will appreciate any more efficient solution than mine above.
As suggested by #Florent B, the following function gives the same results using RegExp:
Function TokenRegex(str As String) As String()
Dim objRegEx As New RegExp
Dim strPattern As String
strPattern = "(""(?:""""|[^""])*""|[^\s()+\-\/*^<>=,]+|<=|>=|\S)\s*"
With objRegEx
.Global = True
.MultiLine = False
.IgnoreCase = True
.Pattern = strPattern
End With
str = objRegEx.Replace(str, "$1" & ChrW(-1))
If Right(str, 1) = ChrW(-1) Then str = Left(str, Len(str) - 1)
TokenRegex = Split(str, ChrW(-1))
End Function
I'm trying to concatenate multiple strings and separate them by comma,
and then subsequently to remove excess, leading and trailing commata.
For example, with an input of TEST("", "b", "c", "", ""), I would like to get
b, c
However, my regex ,$| ,+|^, does not really take repeated commas into account:
Function TEST(a, b, c, d, e)
res = a & ", " & b & ", " & c & ", " & d & ", " & e
Debug.Print (res)
Dim regex As Object, str, result As String
Set regex = CreateObject("VBScript.RegExp")
With regex
.Pattern = ",$| ,+|^,"
End With
Dim ReplacePattern As String
ReplacePattern = ""
res = regex.Replace(res, ReplacePattern)
TEST = res
End Function
How can I do this?
Most elegant is #ScottCraner's suggestion of TEXTJOIN (will remove this part of answer, if he wishes to post this as his own)
Private Function nonEmptyFields(ParamArray strings() As Variant) As String
nonEmptyFields = WorksheetFunction.TextJoin(",", True, Array(strings))
End Function
Note: This will only work for Office 365+, but you can always create your own version of
TEXTJOIN
Another option would be to loop over the ParamArray of strings and add them together, depending on their content (whether they are populated or empty)
Private Function nonEmptyFields(ParamArray strings() As Variant) As String
Dim result As String
Dim i As Byte
For i = LBound(strings) To UBound(strings)
If Len(strings(i)) <> 0 Then
If result = vbNullString Then
result = strings(i)
Else
result = result & "," & strings(i)
End If
End If
Next i
nonEmptyFields = result
End Function
Both would yield desired result with set up of
Debug.Print nonEmptyFields(a, b, c, d, e, f) ' "", "b", "c", "", "", ""
My ugly solution maintaining the same parameters:
Function TEST(a, b, c, d, e)
If a <> "" Then res = a
If b <> "" Then
If res <> "" Then
res = res & ", " & b
Else
res = b
End If
End If
If c <> "" Then
If res <> "" Then
res = res & ", " & c
Else
res = c
End If
End If
If d <> "" Then
If res <> "" Then
res = res & ", " & d
Else
res = d
End If
End If
If e <> "" Then
If res <> "" Then
res = res & ", " & e
Else
res = e
End If
End If
TEST = res
End Function
How do I save email (msg)?
This code creates a daily folder structure and saves email attachments but not the email itself.
Option Explicit
Public Sub saveAttachtoDisk(itm As Outlook.mailitem)
Dim objAtt As Outlook.Attachment
Dim SaveFolder As String
SaveFolder = "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)
' Check for folder and create if needed
If Len(Dir("C:\Temp\" & Year(Date), vbDirectory)) = 0 Then
MkDir "C:\Temp\" & Year(Date)
End If
If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date), _
vbDirectory)) = 0 Then
MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date)
End If
If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date), _
vbDirectory)) = 0 Then
MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)
End If
For Each objAtt In itm.Attachments
objAtt.SaveAsFile SaveFolder & "\" & Format(Date, "yyyymmdd") & "_" & _
objAtt.DisplayName
Next
Set objAtt = Nothing
End Sub
Try
Dim FileName As String
FileName = Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName
itm.SaveAs SaveFolder & "\" & FileName & ".msg", olMsg
Also Replace invalid characters with empty strings, here I'm using Regex
For Each objAtt In itm.Attachments
Dim FileName As String
FileName = Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName
objAtt.SaveAsFile SaveFolder & "\" & FileName
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.Pattern = "[^\w\#-]"
.IgnoreCase = True
.Global = True
End With
FileName = RegEx.Replace(FileName, " ")
itm.SaveAs SaveFolder & "\" & FileName & ".msg", olMsg
Next
Now test your code with Selection.item(1)
Public Sub Test_Rule()
Dim olMsg As Outlook.mailitem
Set olMsg = ActiveExplorer.Selection.Item(1)
saveAttachtoDisk olMsg
End Sub
Call itm.SaveAs(..., olMsg) to save in the MSG format
I have been looking for a very long time for a macro that can loop through a column of cells and replace each space with / if the adjacent words begin with the same letter, else replace with &.
The number of 3 letter combinations in each cell can very from blank to an excess of 20+.
Example
DZP DOP DMM HTP HZW UTT
to
DZP/DOP/DMM&HTP/HZW&UTT
Each letter grouping that begins with D as DZP DOP should have their space replaced with / to become DZP/DOP but DMM and HTP should be DMM&HTP is the first letters of each word is different.
I know I need to compare length of string and relative position and then iterate the process with an If Then Else statements. But I am at a loss just to begin the if.
Furthermore I have found many sites on how to compare cells, but I have yet to find how to come words with in a cell.
Any help would be great, especially if you can explain how to write a comparative formula to compare very 4th character.
Thank you for you time.
The below function will replace the spaces with slashes if the next word begins with the same letter. It will only work with words of exactly three letters.
Function ReplaceSpaces(StrIn As String) As String
'Start at the first space
If Len(StrIn) > 3 Then
i = 4
Do
If Len(StrIn) > i And Mid(StrIn, i, 1) = " " Then
If Mid(StrIn, i - 3, 1) = Mid(StrIn, i + 1, 1) Then
StrIn = Left(StrIn, i - 1) & "/" & Right(StrIn, Len(StrIn) - i)
Else
StrIn = Left(StrIn, i - 1) & "&" & Right(StrIn, Len(StrIn) - i)
End If
End If
Debug.Print Chr(34) & Mid(StrIn, i, 1) & Chr(34)
i = i + 4
Loop Until i > InStr(1, StrIn, " ")
ReplaceSpaces = StrIn
End If
End Function
This second function will work with words of any length, including varied length (i.e. a 4-letter word followed by a 3-letter word, followed by a 6-letter word, etc.).
Function BetterReplaceSpaces(StrIn As String) As String
Dim lastfirstletter As Integer, i As Integer
lastfirstletter = 1
If InStr(1, StrIn, " ") > 0 Then
i = InStr(1, StrIn, " ")
Do
'If Len(StrIn) > i And Mid(StrIn, i, 1) = " " Then
If Mid(StrIn, lastfirstletter, 1) = Mid(StrIn, i + 1, 1) Then
StrIn = Left(StrIn, i - 1) & "/" & Right(StrIn, Len(StrIn) - i)
Else
StrIn = Left(StrIn, i - 1) & "&" & Right(StrIn, Len(StrIn) - i)
End If
'End If
Debug.Print Chr(34) & Mid(StrIn, i, 1) & Chr(34)
lastfirstletter = i + 1
i = InStr(1, StrIn, " ")
Loop Until i = 0
BetterReplaceSpaces = StrIn
End If
End Function
I am trying to get all the group users in a computer. If I do this manually, my way is to go to Computer Management to get the list of Local Users and Group, and from there, I can get the list of Users and Group.
This is my code and I use AutoIt:
Func User()
Local $objWMIService, $colSettings, $objComputer, $strComputer = "."
;# Initiate the object
$objWMIService = ObjGet("winmgmts:{impersonationLevel=impersonate}!\\" & $strComputer & "\root\cimv2")
;# Check if it's an object
If IsObj($objWMIService) Then
;# Search for PC Infomration
$colSettings = $objWMIService.ExecQuery("Select * from Win32_GroupUser")
If IsObj($colSettings) Then
For $objComputer In $colSettings
If $objComputer.AccountType <> '' Then
Return MsgBox(0, "RETURN", "AccountType: " & $objComputer.AccountType & #CRLF & "Full Name: " & $objComputer.FullName & #CRLF & "Caption: " & $objComputer.Caption & #CRLF & "Name: " & $objComputer.Name)
EndIf
Next
Else
MsgBox(0, "RETURN", $colSettings & " IS NOT AN OBJ")
EndIf
Else
MsgBox(0, "RETURN", $objWMIService & " IS NOT AN OBJ")
EndIf
EndFunc ;==>User
However, no output is being returned. Is my query correct at all?
Try this : "Computer Info UDF"
Also, I found this old snippet. (Not tested!)
Dim $InGroup
$oMyError = ObjEvent("AutoIt.Error", "ComError")
If UserInGroup(#LogonDomain, #UserName, "Administrator") Then
MsgBox(0, "Validate", #LogonDomain & "/" & #UserName & " : User in your groupname " & $InGroup)
Else
MsgBox(0, "Validate", #LogonDomain & "/" & #UserName & " : User NOT in your groupname")
EndIf
Exit
; Check if User is in a group
Func UserInGroup($Domain, $UserName, $InGroup)
;local $sRet
Local $objUser = ObjGet("WinNT://" & $Domain & "/" & $UserName)
For $oGroup In $objUser.Groups
If $oGroup.Name = $InGroup Then Return 1
Next
Return 0
EndFunc ;==>UserInGroup
;COM Error function
Func ComError()
If IsObj($oMyError) Then
$HexNumber = Hex($oMyError.number, 8)
SetError($HexNumber)
Else
SetError(1)
EndIf
Return 0
EndFunc ;==>ComError
#cs
; Generated by AutoIt Scriptomatic
$wbemFlagReturnImmediately = 0x10
$wbemFlagForwardOnly = 0x20
$colItems = ""
$strComputer = "localhost"
$Output=""
$Output = $Output & "Computer: " & $strComputer & #CRLF
$Output = $Output & "==========================================" & #CRLF
$objWMIService = ObjGet("winmgmts:\\" & $strComputer & "\root\CIMV2")
$colItems = $objWMIService.ExecQuery("SELECT * FROM Win32_GroupUser", "WQL", _
$wbemFlagReturnImmediately + $wbemFlagForwardOnly)
If IsObj($colItems) then
For $objItem In $colItems
$Output = $Output & "GroupComponent: " & $objItem.GroupComponent & #CRLF
$Output = $Output & "PartComponent: " & $objItem.PartComponent & #CRLF
if Msgbox(1,"WMI Output",$Output) = 2 then ExitLoop
$Output=""
Next
Else
Msgbox(0,"WMI Output","No WMI Objects Found for class: " & "Win32_GroupUser" )
Endif
#ce
#include <Constants.au3> ; required for StdoutRead
; populate $groupstring with the output of net user /domain
; remove the /domain if you are just interested in local machine groups
$foo = Run(#ComSpec & " /c net user " & #UserName & " /domain", #SystemDir, #SW_HIDE, $STDOUT_CHILD)
$groupstring = ""
While 1
$groupstring &= StdoutRead($foo)
If #error = -1 Then ExitLoop
WEnd
Func ingroup($which)
If $which = "*" Then Return 1
$which = StringLeft($which, 21) ; net user /domain returns only the first 21 chars of each group
$which = "*" & $which
If StringInStr($groupstring, $which) Then
Return 1
Else
Return 0
EndIf
EndFunc ;==>ingroup
;example usage
If ingroup("Domain Admins") Then
$admin = True
Else
$admin = False
EndIf