Excel VBA Run Time Error '424' object required - vba

I am totally new in VBA and coding in general,
i want to attache a pdf (Print.pdf) to a specific field (alias_3) in a lotus notes database but i am getting the error 424.
Any suggestions what i am doing incorrectly?
Sub aa()
Dim alias_3 As String
Set notesface = CreateObject("Notes.NotesSession")
Set makeup = Nothing
Set makeup = notesface.GetDatabase("C2S2/ConsolidatedContracts", "p_dir\bpcmrtuat.nsf")
Set docu = makeup.GetDocumentByID("00002BE6")
Attachment1 = "C:\Users\Desktop\aloxa\Print.pdf"
rtitem = docu.HasEmbedded
For Each test2 In docu.GetItemValue("alias_3")
test = test2.HasEmbedded ----> here i am getting the error
Set EmbedObj1 = docu.alias_3.embedobject(1454, "attachment1", Attachment1, "")
Exit For
Next test2
Set EmbedObj1 = test.embedobject(1454, "", Attachment1, "")
Set AttachME = test.CreateRichTextItem("attachment1")
docu.GetItemValue ("alias_3")
If Attachment1 <> "" Then
Set AttachME = docu.CreateRichTextItem("Attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", Attachment, "")
On Error GoTo 0
End If
ExitSub:
End Sub

According to the Lotus Note documentation, GetItemValue() returns either a String, an array of String, or an array of Doubles, none of them having a HasEmbedded property.

Your codes mixes getting values from an item with attaching things to another item, etc.
First of all: Do you REALLY have a richtextitem called "alias_3" in the design of the form that your document is made of? Or is the name of the item "Attachment1" as in your second part of the code? Or is it a default mail database, then the name of the item would be "Body"?
Just replace "alias_3" in the following code with the appropriate itemname. The complete code can be reduced to these lines (I replaced the variable names, so that another developer KNOWS what you mean by using "defaults"):
Set ses = CreateObject("Notes.NotesSession")
Set db = ses.GetDatabase("C2S2/ConsolidatedContracts", "p_dir\bpcmrtuat.nsf")
Set doc = db.GetDocumentByID("00002BE6") '- This line is dangerous, because the noteid can change easily...
strAttachmentPath = "C:\Users\Desktop\aloxa\Print.pdf"
Set rtItem = doc.GetFirstItem( "alias_3" )
If not rtItem.HasEmbedded() then
Call rtItem.embedobject(1454, "", strAttachmentPath , "")
Else
'- what do you want to do, if there is already an embedded attachment?
End if
Call doc.Save( True, True, True )

Related

Stumbling Block Inventor iProperty doesn't exist

I should start out with this is my first attempt at a vba user form.
I Have some simple code to fill a user form (pulling from Inventor Custom iProperties) the problem I am running into and made a false assumption (that if the property didn't exist it would be ignored) so now I get an error. oProSet1 & oProSet2 work perfectly (Those iProperties will always have a value) oProSet3 Throws an error, I am guessing because the "Setup Time" property doesn't exist & Isn't required (in this case). The code asterisks is my attempt and fail to use an if statement.
Private Sub CommandButton2_Click()
' Get the active document.
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
' Get the custom property set.
Dim oPropSet As PropertySet
Set oPropSet = oDoc.PropertySets.Item( _
"Inventor User Defined Properties")
Dim oPropSet1 As Property
Set oPropSet1 = oPropSet("Operation 1 Work Center 1")
' Set the value of the property.
TextBox1.Value = oPropSet1.Value
Dim oPropSet2 As Property
Set oPropSet2 = oPropSet("Operation 1 Machine Code 1")
' Set the value of the property.
TextBox2.Value = oPropSet2.Value
*Dim oPropSet3 As Property
Set oPropSet3 = oPropSet("Operation 1 Setup Time 1")
If oPropSet3("Operation 1 Setup Time 1") Is Nothing Then
' Set the value of the property.
oPropSet3.Value = ""
Else TextBox3.Value = oPropSet3.Value*
I would try like this:
Dim oPropSet3 As Property
On Error Resume Next 'ignore error if missing
Set oPropSet3 = oPropSet("Operation 1 Setup Time 1")
On Error Goto 0 'stop ignoring errors
If oPropSet3 Is Nothing Then
Debug.Print "Property not found"
Else
Debug.Print oPropSet3.Value
End If

Find out if an attachment is embedded or attached

I am coding a small VBA to show all attachments of an email in a list box.
The user can select attachments that should be removed from the email and stored on a target folder.
I am also adding a HTML file to the email that contains a list of all removed files (including a link to each file to the target folder).
I have a problem with images, because they can be
Attached as a normal file to the email
Embedded to the email body (like a company logo in the signature)
I want to show in my list box only those images, that are attached as files to the email.
Embedded mails should be ignored.
Sub SaveAttachment()
Dim myAttachments As Outlook.Attachments
Dim olMailItem As Outlook.MailItem
Dim lngAttachmentCount As Long
Dim Attachment_Filename As String
Select Case True
Case TypeOf Application.ActiveWindow Is Outlook.Inspector
Set olMailItem = Application.ActiveInspector.CurrentItem
Case Else
With Application.ActiveExplorer.Selection
If .Count Then Set olMailItem = .Item(1)
End With
If olMailItem Is Nothing Then Exit Sub
End Select
Set myAttachments = olMailItem.Attachments
If myAttachments.Count > 0 Then
For lngAttachmentCount = myAttachments.Count To 1 Step -1
'-------------------------------------------------------------------------
' Add the attachment to the list of attachments (form)
'-------------------------------------------------------------------------
Attachment_Filename = myAttachments(lngAttachmentCount).FileName
With UserForm1.lstAttachments
.AddItem (Attachment_Filename)
.List(lngAttachmentListPos, 1) = Attachment_Type_Text
.List(lngAttachmentListPos, 2) = FormatSize(myAttachments(lngAttachmentCount).Size) & " KB"
End With
Next lngAttachmentCount
End If
End Sub
I added only the relevant parts of the code, so I hope I have not forgotten anything.
At the moment I show all attachments (also embedded images).
How would I find out if an attachment is embedded?
I found a possible solution here:
Distinguish visible and invisible attachments with Outlook VBA
The source code provided is not working, it seems like the two URLs in line 2 and 3 no longer exist.
I'm not sure if this is a solution that is valid in all cases, but it works in my environment. That means "test it properly".
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Function IsEmbedded(Att As Attachment) As Boolean
Dim PropAccessor As PropertyAccessor
Set PropAccessor = Att.PropertyAccessor
IsEmbedded = (PropAccessor.GetProperty(PR_ATTACH_CONTENT_ID) <> "")
End Function
Call it with
If IsEmbedded(myAttachments(lngAttachmentCount)) Then
...
End If
The cryptic url-looking constant is not a url, but a property identifier. You can find a list of them here: https://interoperability.blob.core.windows.net/files/MS-OXPROPS/%5bMS-OXPROPS%5d.pdf
That property is set to the url of the attachment if embedded. If not embedded, then it is empty.
In the Outlook object model it's very important to marshal your objects correctly. Leaving a PropertyAccessor hanging about is not good, so I would suggest a minor modification to the accepted answer as follows:
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
Function IsEmbedded(Att As Attachment) As Boolean
Dim PropAccessor As PropertyAccessor = Nothing
Try
PropAccessor = Att.PropertyAccessor
Return (PropAccessor.GetProperty(PR_ATTACH_CONTENT_ID) <> "")
Catch
Return False
Finally
If PropAccessor IsNot Nothing
Marshal.ReleaseCOMObject(PropAccessor)
End If
End Catch
End Function
With the help of the answer and comment from #DinahMoeHumm we went with this solution which seems to work:
Function outlook_att_IsEmbedded(Att As outlook.Attachment) As Boolean
Dim PropAccessor As outlook.PropertyAccessor
On Error GoTo outlook_att_IsEmbedded_error
outlook_att_IsEmbedded = False
Set PropAccessor = Att.PropertyAccessor
If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "" Or _
PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3713001E") <> "" Then
If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x37140003") = 4 Then
outlook_att_IsEmbedded = True
End If
End If
outlook_att_IsEmbedded_exit:
Set PropAccessor = Nothing
Exit Function
outlook_att_IsEmbedded_error:
outlook_att_IsEmbedded = False
Resume outlook_att_IsEmbedded_exit
End Function
I don't know what the different probtags mean. Or what the 4 is. It seems like you could find a list of them here: https://interoperability.blob.core.windows.net/files/MS-OXPROPS/%5bMS-OXPROPS%5d.pdf (but I didn't)

Weird characters in email body

I have a little problem with VBScript. There is how it should work. It is a simply code that should go through all emails in particular folder, get particular email body and try to find regular expression. It works correctly on my computer but somehow the same code is not working on other laptop (my friend laptop). Most (not all of them) of emails body look very weird like on attached screen below:
I would like to add that we had the same email messages to test. What is also curious, after use script, it converts first email into these weird characters.
And this is how code looks:
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objMailbox = objNamespace.Folders(Main_mailbox)
Set objMainMailbox = objMailbox.Folders(Main_folder)
Set objFolder = objMainMailbox.Folders(Sub_folder)
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "<.+>"
Set colItems = objFolder.Items
NumberOfEmails = colItems.Count
WScript.Echo NumberOfEmails & " emails found"
For i = NumberOfEmails To 1 Step - 1
BodyMsg = colItems(i).Body
Lines = Split(BodyMsg, vbCrlf)
For j = 1 To UBound(Lines)
If InStr(1, Lines(j), "Reply-To:") Then
Set RegMatches = re.Execute(Lines(j))
For Each myMatch In RegMatches
OutputMatch = OutputMatch & " " & myMatch & ";"
OutputMatch = Replace(OutputMatch, "<", "", 1, 1)
OutputMatch = Replace(OutputMatch, ">", "", 1, 1)
EmailCount = EmailCount + 1
Next
End If
Next
Next
I am wondering if it is about encoding or something like that and if that problem is caused by system settings?
If you need some more information that I forgot mention about, please let me know.
That sure sounds like you are running into an NDR (Non-Delivery Report - represented by the ReportItem object) - ReportItem.Body returns gibberish when accessed though the Outlook Object Model. This has been a problem for a few versions of Outlook now.
You can either skip items like this by checking that you only get the MailItem object (Class property must be 43 (olMail)) or use Redemption (I am its author) - its RDOReportItem object does not have this problem.

Saving multiple e-mails to pdf with PDFMAKER

I'm brand spanking new to VBA. But I've programmed a bit in SAS, just a bit in Assembler (mainframe and PC), Word Perfect (macros), a bit in Java, HTML, other stuff. What I do is, when I have a problem and I think I can program it, I look for code on the internet and adjust it to fit my needs. I have read a little bit of VBA programming. What I'm trying to do is make a macro to save a bunch of Outlook e-mail messages with PDFMAKER. I've come up with the below, so far. When I step the program, pmkr2 gets assigned type "ObjectPDFMaker" and stng gets assigned type "ISettings". So far, so good. Then I try to set stng and can't do it. I get the error "Method or data member not found." If I get rid of Set it highlights .ISettings and I get the same error. I go into F2 and the AdobePDFMakerforOffice library is there, and the class ISettings is there, but I can't seem to set stng. I'm wa-a-a-ay frustrated. Please help.
Sub ConvertToPDFWithLinks()
Dim pmkr2 As Object
Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
Set stng = AdobePDFMakerForOffice.ISettings
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr.GetCurrentConversionSettings stng
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
I updated your code a little. See if this has any affect:
Sub ConvertToPDFWithLinks()
Dim pmkr2 As AdobePDFMakerForOffice.PDFMaker
'Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Set pmkr2 = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr2 = a.Object
Exit For
End If
Next
If pmkr2 Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
pmkr2.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
The main changes were in how the addin is obtained and in how stng is created.

Lotus Notes VBA Email Automation - db.CreateDocument Command Fail

I'm trying to automate the sending of an email through Lotus Notes 9.0 using VBA. The code will load up notes, which asks for my password but before the password prompt shows up, I get an error. The error I run in to is "Run-time error '-2147417851 (80010105)': Automation Error The server threw an exception" When I hit debug, the line that it fails on is "Set obDoc = obDB.CreateDocument". A lot of what I've seen online example wise matches what I'm doing in my code, so I'm not sure where the problem is.
Here's the code:
Sub Send_Emails()
Dim stSubject As Variant
Dim emailList As Variant
Dim obSess As Object
Dim obDB As Object
Dim obDoc As Object
'----Create Email List - separate function, dynamically creates email list based off report processing done in other functions
CreateEmailList
'----Info for Subject
stSubject = "test subject"
'----Create Notes Session
Set obSess = CreateObject("Notes.NotesSession")
Set obDB = obSess.GETDATABASE("", "")
If obDB.IsOpen = False Then
Call obDB.OPENMAIL
End If
'----Create the e-mail - **FAILURE OCCURS HERE**
Set obDoc = obDB.CreateDocument
'----Add values to the email
With obDoc
.form = "Memo"
.SendTo = "test#test.com"
.blindcopyTo = emailList
.Subject = stSubject
.HTMLBody = "<HTML><BODY><p>test</p></BODY></HTML>"
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, emailList
End With
'----Clean Up
Set obDoc = Nothing
Set obDB = Nothing
Set obSess = Nothing
MsgBox "The e-mail has been sent successfully", vbInformation
End Sub
You mention that you are using Notes 9, so I looked at the online help for Notes 9.01 and the help page for the OpenMail method says
Note: This method is supported in LotusScript® only. For COM, use OpenMailDatabase in NotesDbDirectory.
Now, you're actually using the OLE automation classes (rooted at Notes.NotesSession), not the COM classes (rooted at Lotus.NotesSession), so I don't know if you can use the NotesDbDirectory class or not, but the other way of opening the current user's mail database would be to call NotesSession.GetEnvironmentString("MailServer",true) and NotesSession.GetEnvironmentString("MailFile",true), and use those as the values for your call to GetDatabase.