I have emails with a generic subject line like this:
You have received a new notification from ABC
The email body has text like this:
Team: NA Inventory
Division: American Division
I have a rule to identify the "You have received a new notification from ABC" to then run a script to change the name with: objMail.subject = "test done"
I'd like to use the body text to rename the subject line like this:
You have received a new notification from ABC -- American Division -- NA Inventory
I think your question is how to extract the keyword form mail body text.
If so, use VBScript.RegExp to extract keywords from mail body objMail.Body, as follows.
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = False
.Pattern = "\bTeam: ([^\n\r\f]*)"
Set reMatch = .Execute(objItem.Body)
team = reMatch(0).SubMatches(0)
.Pattern = "\bDivision:\s*([^\n\r\f]*)"
Set reMatch = .Execute(objItem.Body)
division = reMatch(0).SubMatches(0)
End With
objItem.Subject = ".... --- " & team & " --- " & division
Related
I have some specific things I need to automatically bold and am having issues coming up with the right code for this... Below is an example:
Product Name:
Customer Account/Name:
Description of Issue:
So, what I need is only bold the above and nothing after the ":", example:
Product Name: Tech Tools
Customer Account/Name: Federation of Planets
Description of Issue: NCC-1701 leaking
So, all of my VBA experience comes from Excel... Which I stupidly started this in excel and then realized that wouldn't work and was like "Oh, I can just use my vba from Excel in Word!" No... no I can't...
Here is my Excel VBA:
Sub Find_and_Bold()
Dim rCell As Range, sToFind As String, iSeek As Long
Dim Text(1 To 33) As String
Dim i As Integer
Text(1) = "Product Name:"
Text(2) = "Project ID and/or URL:"
Text(3) = "Permission to join project?"
Text(4) = "Permission to join Account as Admin?"
Text(5) = "No. of Users on Project:"
Text(6) = "Company/Account Name:"
Text(7) = "Reported by:"
Text(8) = "Reporting User Role in Project:"
Text(9) = "Platform, Version, OS Version:"
Text(10) = "Which platform does this organization/user mainly use?"
Text(11) = "Can the agent repro in test project?"
Text(12) = "Is this related to a third-party integration? (If so, please provide name):"
Text(13) = "What is the company and project name in the third-party software?"
Text(14) = "Has the reporter been able to perform this action with no issues in the past?"
Text(15) = "Pype-Spec Version Name (if applicable):"
Text(16) = "Salesforce ID:"
Text(17) = "Description of Issue:"
Text(18) = "Steps to Reproduce:"
Text(19) = "1."
Text(20) = "2."
Text(21) = "3."
Text(22) = "4."
Text(23) = "Expected Behavior:"
Text(24) = "Observed Behavior"
Text(25) = "Additional Observation/Notes"
Text(26) = "Company/Account name:"
Text(27) = "Can the agent repro in customer project?"
Text(28) = "Is this related to a third party integration?"
Text(29) = "Pype-Spec version name (if applicable):"
Text(30) = "Has the customer provided screenshots/screen- recordings?"
Text(31) = "Description of issue:"
Text(32) = "# of Users on Project:"
Text(33) = "# of Users on Project:"
For Each rCell In Range("A1:A100")
For i = LBound(Text) To UBound(Text)
sToFind = Text(i)
iSeek = InStr(1, rCell.Value, sToFind)
Do While iSeek > 0
rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
Loop
Next i
Next rCell
Call DeleteBlankRows
End Sub
It seems to me you could do the lot without VBA, just using a wildcard Find/Replace, where:
Find = [!^13]#[:\?.]
Replace = ^&
and:
Find = [!^13][1-4].
Replace = ^&
with the replacement font attribute set to Bold or, better still, to the 'Strong' character Style.
The only string that might be missed is 'Observed Behavior' - because in your code it lacks a terminating ':'.
The above can, of course, be turned into VBA.
I have a list of strings defined as
Dim replyFormat(0 To 999) As String
and a list of answers as
Dim answers(0 to 999) As String
and throughout the code certain strings get added to replyFormat that look similar to this:
Name: {1} {3}
When everything is done, I define a string called sendBack and start looping through each line in replyFormat. I want to set sendBack equal to itself plus what replyFormat is, evaluating answers for the numbers in the curly brackets and finally adding vbCrLf to the end. For exmaple if answers contains { Yes, John, H, Doe } and replyFormat is "Name: {1} {3}" it would ouput "Name: John Doe"
It sounds like you're referring to reflection which isn't supported in VBA. You can however achieve the desired result by using Regular Expressions (RegEx):
Function FormattedString(stringToFormat As String, replacements() As String) As String
Dim placeholder As Variant
Dim index As Long
With CreateObject("VBScript.RegExp")
.Pattern = "\{([\d]{1,3})\}"
.Global = True
.MultiLine = False
.IgnoreCase = True
If .Test(stringToFormat) Then
For Each placeholder In .Execute(stringToFormat)
index = CLng(placeholder.SubMatches(0))
stringToFormat = Replace$(stringToFormat, placeholder, replacements(index))
Next
End If
End With
FormattedString = stringToFormat
End Function
Example use:
Sub FooBar()
Dim answers(0 To 3) As String
Const testString = "Name: {1} {3}"
answers(0) = "Test"
answers(1) = "John"
answers(2) = "Testing"
answers(3) = "Doe"
Debug.Print FormattedString(testString, answers) '// "Name: John Doe"
End Sub
If this is your object:
Ob = { Yes, John, H, Doe},
You could select object item like this:
Ob(1), Ob(3)
For more information, Please refer to this link:
Retrieve the index of an object stored in a collection using its key (VBA)
I am looking to extract initials from a single textbox using Left, mid and other similar functions. The user enters their first, middle initial and last name; assuming spaces and a period after the middle initial. I need to ensure the initials extracted are uppercase, even if the text is entered in lowercase. Any assistance in a code that can accomplish this in VBA for Access would be appreciated. I am able to use the functions individually but am new to coding and am unsure how to string them together correctly.
Private Sub cmdGreeting_Click()
strOutput = Left(txtInput.Value, 1) & Mid(txtinput.value, 1) & Right(txtinput.value, 1)
lblOutput.Caption = strOutput
End Sub
This is as far as I have gotten and I know it's incorrect because I have no idea how to account for the 3 separate names.
Here's a function based on regex. I'm sure someone will chip in to improve it, my VBA regex is rusty. It's based on the regex here where you can see examples of it matching. If you're not familiar with regex at all, they're frightening initially and it's beyond the scope of an answer to explain them.
However, it works by breaking any input into 5 strings:
Initial character of first name
remainder of name
Initial and . if present
Initial letter of last name
remainder of last name
Then, with some simple UCase and LCase, you can compile the require, formatted name. You may want to change the logic - you did imply there would be a middle initial but this assumes it won't always be there, and the dot after the initial may or may not be there.
Note: you need to enable regex in Excel - instructions
Sub normalise()
Debug.Print (proper("Reginald D. Hunter"))
Debug.Print (proper("reginald D. hunter"))
Debug.Print (proper("rEGINALD d. Hunter"))
Debug.Print (proper("Reginald D Hunter"))
Debug.Print (proper("Reginald Hunter"))
Debug.Print (proper("Reginald D. Hunter"))
End Sub
Function proper(text) As String
Dim regexMatch As Object
Dim matches As Object
With New RegExp
.Global = False
.MultiLine = False
.IgnoreCase = False
.Pattern = "([a-zA-Z])([^ ]*)\s*([a-zA-Z]?[. ])?\s*([a-zA-Z])([^ ]*)"
If .test(text) Then
For Each regexMatch In .Execute(text)
Set matches = regexMatch.SubMatches
Next
End If
End With
proper = UCase(matches(0)) + LCase(matches(1))
If Trim(matches(2)) <> "" Then
If InStr(matches(2), ".") Then
proper = proper + " " + Trim(UCase(matches(2))) + " "
Else
proper = proper + " " + Trim(UCase(matches(2))) + ". "
End If
Else
proper = proper + " "
End If
proper = proper + UCase(matches(3)) + LCase(matches(4))
End Function
Results in
Reginald D. Hunter
Reginald D. Hunter
Reginald D. Hunter
Reginald D. Hunter
Reginald Hunter
Reginald D. Hunter
Edit: I misread the question and if you just want initials then replace the last part of the function like so:
proper = UCase(matches(0))
If Trim(matches(2)) <> "" Then
If InStr(matches(2), ".") Then
proper = proper + Replace(Trim(UCase(matches(2))), ".", "")
Else
proper = proper + Trim(UCase(matches(2)))
End If
End If
proper = proper + UCase(matches(3))
gives:
RDH
RDH
RDH
RDH
RH
RDH
This is the code I've been using for a while. It will include the the initials of double-barreled names as well.
?GetInitials("Darren Bartrup-Cook") will return DBC.
?GetInitials("The quick brown fox jumps over the lazy dog") will return TQBFJOTLD.
Public Function GetInitials(FullName As String) As String
Dim RegEx As Object
Dim Ret As Object
Dim RetItem As Object
On Error GoTo ERR_HANDLE
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.IgnoreCase = True
.Global = True
.Pattern = "(\b[a-zA-Z])[a-zA-Z]* ?"
Set Ret = .Execute(FullName)
For Each RetItem In Ret
GetInitials = GetInitials & UCase(RetItem.Submatches(0))
Next RetItem
End With
EXIT_PROC:
On Error GoTo 0
Exit Function
ERR_HANDLE:
'Add your own error handling here.
'DisplayError Err.Number, Err.Description, "mdl_GetInitials.GetInitials()"
Resume EXIT_PROC
End Function
How do I extract the username out of an email address in VBA?
For example - if my email ID is "prateek#gmail.com", then the username is "prateek".
Set Reg1 = New RegExp
' \s* = invisible spaces
' \d* = match digits
' \w* = match alphanumeric
With Reg1
.Pattern = "\w+#gmail\.com"
.Global = True
End With
If Reg1.Test(emailAddress) Then
Set M1 = Reg1.Execute(emailAddress)
For Each M In M1
' M.SubMatches(1) is the (\w*) in the pattern
' use M.SubMatches(2) for the second one if you have two (\w*)
Debug.Print M.SubMatches(1)
Next
End If
It doesn't look like this got any submatch.
Try the code below, insread of RegEx you could use Left combined with Instr.
Dim usern As String
'emailAddress = "prateek#gmail.com" ' <-- for debug
usern = Left(emailAddress, InStr(emailAddress, "#") - 1)
MsgBox "UserName is " & usern
I'm trying to delete string content before a certain word contained within the string. For example
master_of_desaster#live.de
I'd like to use VBA in order to replace that with
master_of_desaster
Everything after the "word" (#) should be removed, including the "word" itself.
I found a similar topic here, but he asks the opposite.
email = "master_of_desaster#live.de"
ret = Left(email, InStr(1, email, "#") - 1)
Result: master_of_desaster
Thanks to Shai Rado
=split("master_of_desaster#live.de","#")(0)
Just for fun - a regex approach.
Public Sub reg()
Dim re_pattern As String
Dim re As RegExp
Dim email As String
Dim match As Object
Set re = New RegExp
email = "master_of_desaster#live.de"
re_pattern = "(.*)#.*"
With re
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = re_pattern
End With
Set match = re.Execute(email)
Debug.Print match.Item(0).SubMatches(0)
End Sub
A bit hacky but fast ( most Windows API accept zero terminated strings )
ret = Replace("master_of_disaster#live.de", "#", vbNullChar, , 1) ' Chr(0)
I usually use the Split method but with Limit:
ret = Split("master_of_disaster#live.de", "#", 2)(0)
ret = evaluate("left(" & string & ", search(""#"", " & string & ") - 1)")