NET developers.
I am trying to replicate what I've written in Outlook VBA in VB.NET. I've written a function in VBA to extract recipients and save them into a string and this is done in a function. The below code is my attemp in VB.NET and it is not really working at the moment(SplitTarget array has unique ID and I'm testing this on the first element at the moment).
Could you tell me where I've gone wrong?
Dim Recipients As String
Dim Obj As Object
Dim types() As String
types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")
Select Case True
' these items have a Recipients collection
Case UBound(Filter(types, TypeName(objNamespace.GetItemFromID(GlobalVariables.splitTarget(0))))) > -1
Obj = objNamespace.GetItemFromID(GlobalVariables.splitTarget(0))
GlobalVariables.recips = Obj.Recipients
Case TypeName(objNamespace.GetItemFromID(GlobalVariables.splitTarget(0))) = "Recipients"
GlobalVariables.recips = objNamespace.GetItemFromID(GlobalVariables.splitTarget(0))
End Select
For k = 1 To GlobalVariables.recips.Count
If GlobalVariables.recips(k).ToString <> "Caseflow System" Then
If Recipients = "" Then
Recipients = GlobalVariables.recips(k).ToString
Else
Recipients = Recipients & ";" & GlobalVariables.recips(k).ToString
End If
End If
Next
MsgBox("Recipients are: " + Recipients)
Why are you calling Recipient.ToString() (which comes from .Net, not OOM) instead of using Recipient.Name/Address/etc. properties?
Related
I have an attribute tab delimited text file that I want to apply to multiple drawings. In order for AutoCAD to NOT pop up and say "One or more blocks could not be found, do you want to select the data interactively?" , I have to use the HANDLE property of the block. On a given drawing, if I use ATTOUT to see the Handle of my block, I get a value such as '8B3F. Using ATTIN with that Handle works. Applying this to multiple drawings that have different handles, I have to get the handle for each block if each drawing. Here is my code - writing the handle to an excel doc.
xlbook = xlapp.Workbooks.Open(attInText,, False)
xlsheet = xlbook.Worksheets(dwgName)
Dim Handle As String = ""
'get the handle to the CHS11x17TB title block
For Each blk As AutoCAD.AcadBlock In cadDOC.Blocks
If blk.Name.ToUpper = "CHS11X17TB" Then
Handle = blk.Handle
xlsheet.Cells(2, "A").value = Handle
Exit For
End If
Next
Now, the problem is that the Handle is NOT the same as the one generated using ATTOUT - I'll get something like '75B0 using the code. Why do you think ATTOUT gives me a different handle than looping through the blocks of the drawing? I would note that my block is in paperspace, if that makes any difference. If that question cannot be answered, I'm interested in any alternative solutions for getting the handle to my block.
It looks like you're confusing block definition (Block) contained in the block table (Blocks) and block reference (BlockReference) inserted in the ModelSpace or PaperSpace.
Here's a not tested snippet which serac for a block reference in the model space (you can replace ModelSpace with PaperSpace to search the active paper space.
xlbook = xlapp.Workbooks.Open(attInText,, False)
xlsheet = xlbook.Worksheets(dwgName)
Dim Handle As String = ""
'get the handle to the CHS11x17TB title block
For Each obj As AutoCAD.AcadObject In cadDOC.ModelSpace
If obj.ObjectName = "AcDbBlockReference" Then
If obj.EffectiveName.ToUpper = "CHS11X17TB" Then
Handle = obj.Handle
xlsheet.Cells(2, "A").value = Handle
Exit For
End If
End If
Next
Here's what I did to make it work. The block reference I wanted was in the paperspace. Note that EntityType 7 is an AcadBlockReference.
Dim Handle As String = ""
Dim count As Integer
count = cadDOC.PaperSpace.Count
Dim newObjs(count) As AutoCAD.AcadEntity
Dim index As Integer
For index = 0 To count - 1
newObjs(index) = cadDOC.PaperSpace.Item(index)
Next
For i = 0 To count - 1
Try
If newObjs(i).EntityType = 7 Then
Dim blk As AutoCAD.AcadBlockReference = newObjs(i)
If blk.Name.ToUpper = "CHS11X17TB" Then
Handle = "'" & blk.Handle
End If
End If
Catch ex As Exception
End Try
Next
I'm struggling with VBA code. I'm working on a ID code generator program. One of the processes involves Split Company Names by words, and taking the first two words. Split has proved to be useful in this tasks, however, when in dealing with Company Names shorter than 2 words I've got a #VALUE! Error.
One way I tried to fix it, was using the ISERROR function, so if I get any error it replaces it with a character, say "X".
In summary, what I'm trying is to capture only the second Word of the Name, if there is no second Word, just display "X".
Public Function idcode_2(text As String) As String
Dim Arr_text As Variant
Dim rz_x, rz2, code As String
Dim i As Integer
Dim c
Arr_text = Split(text, " ", 3)
rz2 = Arr_text(1)
If IsError(rz2) = True Then
rz2 = "X"
Else
rz2 = rz2 & ""
End If
idcode_2 = rz2
End Function
I'm using VBA in Excel - Microsoft Office Professional Plus 2013.
Arr_text will be a zero-based array - UBound(Arr_text) will give you the upper bound of that array (zero if one item, one if two items, etc)
Public Function idcode_2(text As String) As String
Dim Arr_text As Variant, rz2
Arr_text = Split(text, " ", 3)
If UBound(Arr_text ) > 0 Then
rz2 = Arr_text(1)
Else
rz2 = "x"
End If
idcode_2 = rz2
End Function
Public Function idcode_2(text As String) As String
If Instr(text, " ") > 0 Then
idcode = Split(text)(1)
Else
idcode = "x"
End If
End Function
I am getting a type mismatch error in VBA and I am not sure why.
The purpose of this macro is to go through a column in an Excel spreadsheet and add all the emails to an array. After each email is added to the first array, it's also supposed to added to a second array but split into two pieces at the # symbol in order to separate name from domain. Like so: person#gmail.com to person and gmail.com.
The problem that I'm getting is that when it gets to the point where it's supposed to split the email, it throws a Type Mismatch error.
Specifically this part:
strDomain = Split(strText, "#")
Here is the complete code:
Sub addContactListEmails()
Dim strEmailList() As String 'Array of emails
Dim blDimensioned As Boolean 'Is the array dimensioned?
Dim strText As String 'To temporarily hold names
Dim lngPosition As Long 'Counting
Dim strDomainList() As String
Dim strDomain As String
Dim dlDimensioned As Boolean
Dim strEmailDomain As String
Dim i As Integer
Dim countRows As Long
'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count
countRows = Range("E:E").CurrentRegion.Rows.Count
MsgBox "The number of rows is " & countRows
'The array has not yet been dimensioned:
blDimensioned = False
Dim counter As Long
Do While counter < countRows
counter = counter + 1
' Set the string to the content of the cell
strText = Cells(counter, 5).Value
If strText <> "" Then
'Has the array been dimensioned?
If blDimensioned = True Then
'Yes, so extend the array one element large than its current upper bound.
'Without the "Preserve" keyword below, the previous elements in our array would be erased with the resizing
ReDim Preserve strEmailList(0 To UBound(strEmailList) + 1) As String
Else
'No, so dimension it and flag it as dimensioned.
ReDim strEmailList(0 To 0) As String
blDimensioned = True
End If
'Add the email to the last element in the array.
strEmailList(UBound(strEmailList)) = strText
'Also add the email to the separation array
strDomain = Split(strText, "#")
If strDomain <> "" Then
If dlDimensioned = True Then
ReDim Preserve strDomainList(0 To UBound(strDomainList) + 1) As String
Else
ReDim strDomainList(0 To 0) As String
dlDimensioned = True
End If
strDomainList(UBound(strDomainList)) = strDomain
End If
End If
Loop
'Display email addresses, TESTING ONLY!
For lngPosition = LBound(strEmailList) To UBound(strEmailList)
MsgBox strEmailList(lngPosition)
Next lngPosition
For i = LBound(strDomainList) To UBound(strDomainList)
MsgBox strDomainList(strDomain)
Next
'Erase array
'Erase strEmailList
End Sub
ReDiming arrays is a big hassle. Welcome to the world of collections and Dictionarys. Collection objects are always accessible. Dictionaries require a reference to Microsoft Scripting Runtime (Tools>References>scroll down to find that text and check the box> OK). They dynamically change size for you, you can add, remove items very easily compared to arrays, and Dictionaries especially allow you to organize your data in more logical ways.
In the below code I used a dictionary there the key is the domain (obtained with the split function). Each value for a key is a collection of email addresses with that domain.
Put a break point on End Sub and look at the contents of each of these objects in your locals window. I think you'll see they make more sense and are easier in general.
Option Explicit
Function AllEmails() As Dictionary
Dim emailListCollection As Collection
Set emailListCollection = New Collection 'you're going to like collections way better than arrays
Dim DomainEmailDictionary As Dictionary
Set DomainEmailDictionary = New Dictionary 'key value pairing. key is the domain. value is a collection of emails in that domain
Dim emailParts() As String
Dim countRows As Long
Dim EmailAddress As String
Dim strDomain As String
'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count
Dim sht As Worksheet 'always declare your sheets!
Set sht = Sheets("Sheet1")
countRows = sht.Range("E2").End(xlDown).Row
Dim counter As Long
Do While counter < countRows
counter = counter + 1
EmailAddress = Trim(sht.Cells(counter, 5))
If EmailAddress <> "" Then
emailParts = Split(EmailAddress, "#")
If UBound(emailParts) > 0 Then
strDomain = emailParts(1)
End If
If Not DomainEmailDictionary.Exists(strDomain) Then
'if you have not already encountered this domain
DomainEmailDictionary.Add strDomain, New Collection
End If
'Add the email to the dictionary of emails organized by domain
DomainEmailDictionary(strDomain).Add EmailAddress
'Add the email to the collection of only addresses
emailListCollection.Add EmailAddress
End If
Loop
Set AllEmails = DomainEmailDictionary
End Function
and use it with
Sub RemoveUnwantedEmails()
Dim allemailsDic As Dictionary, doNotCallSheet As Worksheet, emailsSheet As Worksheet
Set doNotCallSheet = Sheets("DoNotCallList")
Set emailsSheet = Sheets("Sheet1")
Set allemailsDic = AllEmails
Dim domain As Variant, EmailAddress As Variant
Dim foundDoNotCallDomains As Range, emailAddressesToRemove As Range
For Each domain In allemailsDic.Keys
Set foundDoNotCallDomains = doNotCallSheet.Range("A:A").Find(domain)
If Not foundDoNotCallDomains Is Nothing Then
Debug.Print "domain found"
'do your removal
For Each EmailAddress In allemailsDic(domain)
Set emailAddressesToRemove = emailsSheet.Range("E:E").Find(EmailAddress)
If Not emailAddressesToRemove Is Nothing Then
emailAddressesToRemove = ""
End If
Next EmailAddress
End If
Next domain
End Sub
strDomain must store array of the split text, therefore,
Dim strDomain As Variant
Afterwards, strDomain should be referenced by index, if operations with certain fragments will be made:
If strDomain(i) <> "" Then
The split function returns an array of strings based on the provided separator.
In your if you are sure that the original string is an email, with just one "#" in it then you can safely use the below code:
strDomain = Split(strText, "#")(1)
This will get you the part after "#" which is what you are looking for.
Split returns an array:
Dim mailComp() As String
[...]
mailComp = Split(strText, "#")
strDomain = mailComp(1)
Try strDomain = Split(strText,"#")(1) to get the right hand side of the split where (0) would be the left. And of course works with more than 2 splits as well. You could dim you string variable as an array strDomain() and then Split(strText,"#") will place all the seperated text into the array.
i get a string whith email adresses, seperated by a ";" which look like this:
geve#krag.de;;;Tobias#nxs.de;Wissel#weg.de;Sand#nex.de;Claudia#bea.de;;
i want to send an appointment to these email adresses here a sample to one person:
Dim appointment As New EWS.Appointment(esb)
appointment.Subject = "Einladung zu einem Termin"
appointment.Body = txtThema.Text
appointment.Start = Von
appointment.End = Bis
appointment.Location = "Raum 202 Kleinostheim"
appointment.RequiredAttendees.Add("geve#krag.de") // HERE ARE THE Attendees
appointment.Save(EWS.SendInvitationsMode.SendToAllAndSaveCopy)
i need every email adresses exept the first, becuase he sends the mails.
how can i do that?
thanks in advance for your help
Here's how you would actually split the string into a string array:
Dim emails As String() = emailString.Split({";"}, StringSplitOptions.RemoveEmptyEntries)
There are other versions of the overloaded "Split" method, but that particular one lets you to pass in a StringSplitOptions value, allowing you to rule out blank entries right away.
After you have the string array, you can loop through and omit the first one in a few different ways.
We could use a For loop and skip the first entry entirely:
' Regular For loop approach
Dim emails As String() = emailString.Split({";"}, StringSplitOptions.RemoveEmptyEntries)
Dim appointment As New EWS.Appointment(esb)
With appointment
.Subject = "Einladung zu einem Termin"
.Body = txtThema.Text
.Start = Von
.End = Bis
.Location = "Raum 202 Kleinostheim"
End With
' start at i = 1 to skip index 0
For i = 1 To emails.Length - 1
appointment.RequiredAttendees.Add(emails(i)) ' HERE ARE THE Attendees
Next
appointment.Save(EWS.SendInvitationsMode.SendToAllAndSaveCopy)
Or identify the sender's email and use a For Each with an If to omit it:
' For Each approach
' set up string array and appointment object like above
Dim sender As String = emails.FirstOrDefault()
' ignore all instances of the sender's address
For Each address In emails
If address.ToLower <> sender.ToLower Then
appointment.RequiredAttendees.Add(emails(i)) ' HERE ARE THE Attendees
End If
Next
appointment.Save(EWS.SendInvitationsMode.SendToAllAndSaveCopy)
I'd say play around with it though, and use the approach that best suits you.
You can use the split function to parse out each email and use Linq to remove blanks and Skip the first entry. I think this syntax will work in VB.
Dim emailString = "geve#krag.de;;;Tobias#nxs.de;Wissel#weg.de;Sand#nex.de;Claudia#bea.de;;"
Dim emaillist = (From email In emailString.Split(";").Skip(1) Where email.Length > 0 Select email).ToArray()
I am creating a for each loop to take the words from a string and place them each into a text box. The program allows for up to "9" variables What I am trying to attempt is.
Foreach word in Words
i = i +1
Varible & i = word
txtCritical1.Text = variable & i
any ideas on a way to make this work?
Have a look through the MSDN article on For Each. It includes a sample using strings.
https://msdn.microsoft.com/en-us/library/5ebk1751.aspx
So i went with a simple if statement this does the trick. Each text box is filled in.
Dim details As String = EditEvent.EditDbTable.Rows(0).Item(13).ToString()
Dim words As String() = details.Split(New Char() {"«"})
Dim word As String
For Each word In words
i = i + 1
v = word
If i = 1 Then
txtCritical1.Text = v
ElseIf i = 2 Then
txtCritical2.Text = v
ElseIf ....
ElseIf i = 9 then
txtCritical2.text = v
Else
....
End If
Next