I am attempting to create a check out log for inventory in Access 2013. During this process you will create an appointment on the expected return date in the Lotus Notes 9 calendar. I have found enough examples to do this successfully. However I am getting stuck when trying to add people to the "RequiredAttendees" field. I am pretty sure that I am using the right field name but i keep getting the following error:
Run-time error '-2147417851 (80010105)': Automation error. The server
threw an exception.
Everything else works fine except the part that tries to add attendees. I know Lotus Notes 9 is old and I know Access 2013 is old but those are the tools I am required to work with. Any help would be appreciated.
Public Function test() As Variant
Dim StartTime As Date
Dim MailDbName As String
Dim CalenDoc As Object
Dim WorkSpace As Object
Dim AppDate As String
Dim AppTime As String
Dim Subject As String
Set WorkSpace = CreateObject("Notes.NOTESUIWORKSPACE")
AppDate = InputBox(Prompt:="Enter the return date:")
'Subject = InputBox(Prompt:="Enter the subject:")
'AppTime = InputBox(Prompt:="Enter the time:")
MailDbName = "mail\User.nsf"
strSTime = CStr(Timex)
Set CalenDoc = WorkSpace.COMPOSEDOCUMENT("MailServer", MailDbName, "Appointment")
CalenDoc.FIELDSETTEXT "AppointmentType", "3"
CalenDoc.Refresh
CalenDoc.FIELDSETTEXT "StartDate", CStr(AppDate)
CalenDoc.FIELDSETTEXT "EndDate", CStr(AppDate)
CalenDoc.FIELDSETTEXT "StartTime", "12:00 PM"
CalenDoc.FIELDSETTEXT "EndTime", "12:00 PM"
CalenDoc.FIELDSETTEXT "Subject", "Test"
GetUser = Environ("UserName")
EmailAddress = GetUser & "#company.com"
If EmailAddress = "User1#company.com" Then
CalenDoc.FIELDSETTEXT "RequiredAttendees", "User2#company.com" & "," & "User3#company.com"
CalenDoc.Refresh
ElseIf EmailAddress = "User2#company.com" Then
CalenDoc.FIELDSETTEXT "RequiredAttendees", "User1#company.com" & "," & "User3#company.com"
CalenDoc.Refresh
ElseIf EmailAddress = "User3#company.com" Then
CalenDoc.FIELDSETTEXT "RequiredAttendees", "User2#company.com" & "," & "User1#company.com"
CalenDoc.Refresh
Else
MsgBox (EmailAddress & "is not a valid email address.")
End If
'CalenDoc.gotoField "Body"
'CalenDoc.InsertText Body
CalenDoc.Refresh
'CalenDoc.Save
'CalenDoc.Close
'Set CalenDoc = Nothing
'Set WorkSpace = Nothing
I think you've been confused by looking at examples that use the back-end COM classes instead of, or maybe in addition to, examples that use the front-end OLE classes. You are using Notes.NOTESUIWORKSPACE - OLE, instead of Lotus.NotesSession - COM. That means you have to use the actual editable fields on the Appointment form, which are sometimes not what you expect them to be. In some cases, these front-end fields are not the same as the items that will end up being stored in the back-end document - and it's the back-end item names that are typically documented because they are the ones that get stored in the note.
RequiredAttendees is the stored item name, but you are getting the automation error because it's a computed field on the Appointment form, not an editable field.
Since you are using OLE, you need to enter the data into the "EnterSendTo" field. The data that you (or a user) puts in there will, in fact, end up in the RequiredAttendees item due to the magic that goes on in the formulas and scripts associated with the Appointment form.
Related
I have a button on an Access form that queues up an email and is linked to several fields on the form. Yesterday and this morning the button was working without issue. I have not changed the underlying code or any of the fields in the form, but suddenly the button is returning a Run-time error '2293': Microsoft Access can't send this e-mail message error message when I click it. An example of the code is as follows:
Private Sub cmd_Button_Click()
Dim toaddress As String
Dim ccaddress As String
Dim subject As String
Dim message As String
toaddress = AddMailAddress(toaddress, Nz(Me.cmb_ProjectLead.Column(1), ""))
toaddress = AddMailAddress(toaddress, Nz(Me.cmb_ProjectLead2.Column(1), ""))
ccaddress = AddMailAddress(ccaddress, Nz(Me.cmb_OtherPOC.Column(1), ""))
ccaddress = AddMailAddress(ccaddress, Nz(Me.cmb_OtherPOC2.Column(1), ""))
subject = "text" & me.txb_ProjectName
message = "text" & me.txb_ProjectName & vbnewline & me.txb_ProjectLocation & vbnewline & me.txb_ProjectDescription
DoCmd.SendObject acSendNoObject, , , toaddress, ccaddress, , subject, message, True
End Sub
When I click "debug" on the error message, the line DoCmd.SendObject acSendNoObject, , , toaddress, ccaddress, , subject, message, True is highlighted yellow with a yellow arrow pointed to it.
A few notes that may be helpful:
I'm working on a work issued computer and I have no Admin rights, so changing certain properties are not possible.
I have to use a VPN which has pretty strict security standards.
To reiterate, this worked up until today. In fact for the same record, it worked one moment, and then 30 seconds later did not work.
*Update: the command worked when I stripped everything except the sendobject line and replaced the values with text, i.e.
Private Sub cmd_Button_Click()
DoCmd.SendObject acSendNoObject, , , "toaddress", "ccaddress", , "subject", "message", True
End Sub
When I added just the toaddress and ccaddress back in, I got the 2293 error message.
*Additional info that may help: This form has several "Email To" buttons as well as some "Send Outlook Apppointment To" buttons. They all also worked fine up until this morning, but are now generating various error messages when clicked. They all use the same toaddress, ccaddress, subject, message, etc format as my example here.
The public function that is also linked to these commands is as follows:
Public Function AddMailAddress(address As String, newaddress As String)
If (address = "") And (newaddress = "") Then
Exit Function
End If
If address = "" Then
address = newaddress
Else
If Not newaddress = "" Then
If VBA.Right(address, 1) = ";" Then
address = address & newaddress
Else
address = address & ";" & newaddress
End If
End If
End If
AddMailAddress = address
End Function
Anytime i get this error, it has nothing to do with the the database or the code, it is simply due to the fact that i have an outlook item open that is currently gettin edited that i have forgotten about.
Access cannot create a new Outlook item while there is currently an Outlook item open in edit mode.
Close down any Outlook items open in edit mode and try again.
The email buttons now work after closing out the database and re-opening it. Still no clue why it gave me run-time errors before. If it happens again, I'll be back to add more insight.
I have different accounts in my Outlook.
Depending on the currently selected folder, I would like to find the smtp Email address of the corresponding account.
(Folder name is no help)
I know how to get the smtp email address of an account:
(olApp.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress)
I know how to get the current selected folder or even its store name:
(olApp.ActiveExplorer.CurrentFolder.store.DisplayName)
but I can't find how to link both information...
Any idea ?
thx :)
Private Sub storeAddress_from_DisplayName()
Dim storeDisplayName As String
Dim storeSMTPAddress As String
Dim storeRecipient As Recipient
' DisplayName and PrimarySmtpAddress can be the same
storeDisplayName = ActiveExplorer.CurrentFolder.Store.DisplayName
Debug.Print " storeDisplayName: " & storeDisplayName
Set storeRecipient = Session.CreateRecipient(storeDisplayName)
If storeRecipient.AddressEntry.Type = "EX" Then
storeSMTPAddress = storeRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Debug.Print " storeSMTPAddress: " & storeSMTPAddress
End If
End Sub
In theory, you could parse the EX store entry id to extract the EX address and then use it to build the GAL entry id that you can use to call Namespace.GetAddressEntryFromID. You can see how the store entry is parsed (in C++) in the MFCMAPI source code.
If using Redemption (I am its author) is an option, it exposes RDOExchangeMailboxStore.Owner property (returns RDOAddressEntry object, which in turn exposes the SMTPAddress property):
Set MySession = CreateObject("Redemption.RDOSession")
MySession.MAPIOBJECT = Application.Session.MAPIOBJECT
set Store = MySession.GetStoreFromID(Application.ActiveExplorer.CurrentFolder.StoreID)
MsgBox Store.Owner.SmtpAddress
I'm looking for the quickest and easiest way to retrieve all Active Directory account's first & last names. The intention is to have a string list which contains all names from the Active Directory, for the purpose of auto-completion in a textbox in a small Visual Basic application used for unlocking accounts.
Usage Scenario:
On form load the application generates the list of names from the AD. I'm expecting this to take around 10-15 seconds as there's 4,500 accounts on the AD. Each name is added to a string list for use with the auto completion.
The user types the name Garry into textbox1 and the auto complete suggests all Garry's in the AD, by using a string list. I know how to do this easily, I just dont know how to populate the list with user's names efficiently.
There's a lot of samples on accessing the AD, but none which show how to loop through it. I thought asking on here would help both myself and other users in a similar usage case.
The code I have so far for accessing a single account is shown below, however I need to loop through all AD accounts and retrieve their First & Last names.
Current Code to access single account:
'Domain is declared with the LDAP path
'UserName is declared with textbox1.text value
Dim ADEntry As New DirectoryServices.DirectoryEntry("LDAP://" & Domain)
Dim ADSearch As New System.DirectoryServices.DirectorySearcher(ADEntry)
ADSearch.Filter = ("(samAccountName=" & UserName & ")")
ADSearch.SearchScope = System.DirectoryServices.SearchScope.Subtree
Dim UserFound As System.DirectoryServices.SearchResult = ADSearch.FindOne()
If Not IsNothing(UserFound) Then
Log.AppendLine("Account found, loading checks...")
Dim Attrib As String = "msDS-User-Account-Control-Computed"
Dim User As System.DirectoryServices.DirectoryEntry
User = UserFound.GetDirectoryEntry()
User.RefreshCache(New String() {Attrib})
'Display user account details
txtLogin.Text = User.Properties("userPrincipalName").ToString
txtName.Text = User.Properties("givenName").ToString & " " & User.Properties("sn").ToString
else
'User not found
end if
Any help would be much appreciated, even in C#.
You can use the same ADEntry variable as above and do something like this. This only adds a user to the list if they have both a first and last name.
Dim listNames As New AutoCompleteStringCollection
Using ADSearch As New DirectoryServices.DirectorySearcher(ADEntry, "(&(objectCategory=person)(objectClass=user))", {"givenName", "sn"}, DirectoryServices.SearchScope.Subtree)
For Each user As DirectoryServices.SearchResult In ADSearch.FindAll
Try
listNames.Add(user.GetDirectoryEntry.Properties("givenName").Value.ToString + " " + user.GetDirectoryEntry.Properties("sn").Value.ToString)
Catch ex As Exception
End Try
Next
End Using
With TextBox1
.AutoCompleteCustomSource = listNames
.AutoCompleteMode = AutoCompleteMode.SuggestAppend
.AutoCompleteSource = AutoCompleteSource.CustomSource
End With
so im learning to use socket and thread things in the networking software. so far, the software (which is not created by me) is able to chat in multiple group, but i'm tasked to allow user to code whisper feature. However, im stuck in the coding area, which im sure will work if the "if" function work inside "for each" function, anyhow here is my code mainly
Private clientCollection As New Hashtable()
Private usernameCollection As New Hashtable()
clientCollection.Add(clientID, CData)
usernameCollection.Add(clientID, username)
oh and before i forgot, the code above and below is on the server form page
on the client side, i write the code:
writer.write("PMG" & vbnewline & txtReceiverUsername & Message)
then next is the checking part on the server reading the message:
ElseIf message.Substring(0, 3) = "PMG" Then
'filter the message, check who to send to
Dim newMessage As String = message.Substring(3)
Dim messagearray As String() = newMessage.Split(vbNewLine)
Dim receiver As String = messagearray(1)
'0 = "", 1 = receiver, 2 = message
as i write before, clientcollection contain (clientID , connection data*) and usernamecollection contain (clientID, username). In my case, i only have the username data, and i need to trace it until the connection data on clientcollection hash table.
'find realid from usernamecollection, then loop clientcollection
Dim clientKey As String = 0
For Each de As DictionaryEntry In usernameCollection
'''''
'this if part Is Not working
If de.Value Is receiver Then
clientKey = de.Key
End If
'''''
Next de
'match objKey with clientcollection key
For Each dec As DictionaryEntry In clientCollection
If dec.Key = clientKey Then
Dim clients As ClientData = dec.Value
If clients.structSocket.Connected Then
clients.structWriter.Write("PMG" & messagearray(2))
End If
End If
Next dec
End If
so, how do i know that the if part is the wrong one? simply i tried these code before the "next de" code
For Each client As ClientData In clientCollection.Values
If client.structSocket.Connected Then
client.structWriter.Write("PMG" & "receiver:" & messagearray(1))
client.structWriter.Write("PMG" & "loop username: " & de.Value)
client.structWriter.Write("PMG" & "loop key: " & de.Key)
client.structWriter.Write("PMG" & "receiver key:" & clientKey)
End If
Next
the code allow me to check the de.key and de.value. they were correct, however the only thing that did not work is the code inside the "if" area.
Can anyone suggest other code maybe beside "if de.key = receiver"? I've also tried using the if de.key.equal(receiver) and it did not work too
I have some VBA code that takes the various email parts as inputs and creates an email message in Lotus Notes, and sends it from a group mailbox. It sends the email out to a recipient and CC recipients, and then leaves a copy of the message in the "Sent" box of a group email account. I think the sent message in that box is sort of a dummy, as it is perhaps not the exact message as it was sent.
This works, and sends the message to the SendTo, and to the first CC address. However, if I have a second CC address, it turns the ending of the second address into gibberish. For example, if the SendTo is "mike#someemail.com", and the CC is "john#someemail.com, jim#someemail.com"... in the Sent box it appears to have sent it to mike#someemail.com, and CC to john#someemail.com and jim#someemail.com. However, the actual mail is only received by john, and the CC looks like this: "john#someemail.com, jim#pps.rte_to_v" and jim never gets the message.
On another message, the second CC ends up being jim#vwall11.com. I haven't found a pattern to the gibberish it puts at the end of the CC line instead of the correct address. It took us awhile to learn about the problem since it looks correct in the Sent mailbox.
Here's the code I'm using. I'm changing the server names, etc, but all relevant code is intact.
Private Sub TestEmail()
Call EmailFromADT("mike#somemail.com", "john#somemail.com, jim#somemail.com", "test subject", "test message", _
"", "", "", "")
End Sub
Function EmailFromADT(strSendTo As String, strCopy As String, strSubject As String, _
strText1 As String, strText2 As String, strText3 As String, _
strText4 As String, strText5 As String)
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object
Dim i As Integer
Set notessession = CreateObject("Notes.Notessession")
''''''''Group Mailbox'''''''''''''''''''''''''''''''''''''''''''''''''
Set notesdb = notessession.GetDatabase("servername", "mailin\notesaddr.nsf")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Open the mail database in notes
If notesdb.IsOpen = True Then
'Already open for mail
Else
notesdb.OPENMAIL
End If
Set notesdoc = notesdb.CreateDocument
Call notesdoc.ReplaceItemValue("Subject", strSubject)
Set notesrtf = notesdoc.CreateRichTextItem("body")
Call notesrtf.AppendText(strText1 & vbCrLf & strText2 & vbCrLf & strText3 & vbCrLf & strText4 & vbCrLf & strText5)
notesdoc.SendTo = strSendTo
notesdoc.CopyTo = strCopy
notesdoc.from = UserName()
''''''''Group Mailbox'''''''''''''''''''''''''''''''''''''''''''''''''
notesdoc.principal = "Group Team"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
notesdoc.BlindCopyTo = strBCC
Call notesdoc.Save(True, False)
notesdoc.SaveMessageOnSend = True
Call notesdoc.Send(False, strSendTo)
Set notessession = Nothing
End Function
To have multiple values in an item in a Document, you need to use an array.
Try this:
dim varCopyTo as Variant
varCopyTo = Split( strCopyTo, "," )
call notesDoc.Replaceitemvalue( "CopyTo", varCopyTo )
You could also write notesDoc.CopyTo=varCopyTo, but it is better (more secure, slightly better performance) to use ReplaceItemValue.
In addition you should add Call notesDoc.ReplaceItemValue("Form", "Memo" ) after creating the document, so that the server/client does not have to "guess" what kind of document you are creating.
notesdoc.CopyTo wants an array, not a comma-delimted string on the right hand side of the assignment. Each element in the array should be an individual address. By passing in a comma-delimited string, you're essentially passing in a single invalid address as far as Notes and Domino are concerned. I'm not entirely sure why that's being transformed in the peculiarly random way that it is, but I am sure it's definitely not going to be right that way.
And better than using the shorthand form (notesdoc.CopyTo = ...) for this code, you should probably be using Call notesdoc.ReplaceItemValue, like you do with the Subject, but passing in an array there.