Saving multiple e-mails to pdf with PDFMAKER - vba

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.

Related

Avaya CMS Automation_Error Via VBA

I am getting the following error while running below macro. I have copy this macro from this side only. I am using below macro to copy dump in excel from Avaya CMS.
Code is as below. I am getting error on step:
Set cvsApp = CreateObject("ACSUP.cvsApplication")
Sub GetIntervalData()
Dim cvsApp As Object
Dim cvsConn As Object
Dim cvsSrv As Object
Dim Rep As Object
Dim Info As Object, Log As Object, b As Object
On Error Resume Next
Set cvsApp = CreateObject("ACSUP.cvsApplication")
Set cvsConn = CreateObject("ACSCN.cvsConnection")
Set cvsSrv = CreateObject("ACSUPSRV.cvsserver")
Set Rep = CreateObject("ACSREP.cvsReport")
'Clear Data
Sheets("Sheet1").Select
Range("A1:AR300").ClearContents
Sheets("Domestic").Activate
serverAddress = "*****"
UserName = "*****"
Password1 = "*****"
If cvsApp.CreateServer(UserName, "", "", serverAddress, False, "ENU", cvsSrv, cvsConn) Then
If cvsConn.Login(UserName, Password1, serverAddress, "ENU") Then
On Error Resume Next
cvsSrv.Reports.ACD = 1
Set Info = cvsSrv.Reports.Reports("Historical\Designer\SLA for skill(s) Daily Summary")
If Info Is Nothing Then
If cvsSrv.Interactive Then
MsgBox "The report Historical\Designer\SLA for skill(s) Daily Summary", vbCritical Or vbOKOnly, "Avaya CMS Supervisor"
Else
Set Log = CreateObject("ACSERR.cvsLog")
Log.AutoLogWrite "The report Historical\Designer\SLA for skill(s) Daily Summary"
Set Log = Nothing
End If
Else
b = cvsSrv.Reports.CreateReport(Info, Rep)
If b Then
Rep.Window.Top = 75
Rep.Window.Left = 690
Rep.Window.Width = 19140
Rep.Window.Height = 11400
Rep.TimeZone = "default"
Rep.SetProperty "Split/Skills", "CA10 CRU Parts;CA10 CRU Tech;CA14 ICG;CA10 LCSC;CA10 USEO P_1;CA14 ICG Overflow"
Rep.SetProperty "Dates", "8/1/2020"
Rep.SetProperty "Times", "00:00-23:30"
b = Rep.ExportData("", 9, 0, False, False, True)
Rep.Quit
If Not cvsSrv.Interactive Then cvsSrv.ActiveTasks.Remove Rep.TaskID
Set Rep = Nothing
End If
End If
Set Info = Nothing
End If
cvsApp.Servers.Remove cvsSrv.ServerKey
cvsConn.logout
cvsConn.Disconnect
cvsSrv.Connected = False
Set Log = Nothing
Set Rep = Nothing
Set cvsSrv = Nothing
Set cvsConn = Nothing
Set cvsApp = Nothing
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
End If
Sheets("Sheet1").Activate
End Sub
enter image description here
enter image description hereCan you give us a screen shot of your VBA References? (if there are MISSING:Libs, that are checked, they should be un-checked) Can you also look in the object browser in Excel to see if that object is actually available?
You shouldn't have to use CreateObject() late binding if the object/lib is referenced. Tools -> References in VBA editor.

Error when saving individual docs from a mail merge

I Have been using a VBA code to individually save all letters separately from a mail merge into a designated folder. It has always worked previously howver with the document I am trying to do it for now it is onyl saving the first document and then coming up with an error stating:
run-time error '5825' object has been deleted
When I go to debug it highlights the line near the bottom reading 'DocResult.Close False'
How can I fix this?
Tried changing this to True or deleting line entirely but does not fix problem. Each document is quite large so takes approx 30 seconds to save
Dim WithEvents wdapp As Application
Dim bCustomProcessing As Boolean
Private Sub Document_Open()
Set wdapp = Application
bCustomProcessing = False
ThisDocument.MailMerge.DataSource.ActiveRecord = 1
ThisDocument.MailMerge.ShowWizard 1
With ActiveDocument.MailMerge
If .MainDocumentType = wdFormLetters Then
.ShowSendToCustom = "Custom Letter Processing"
End If
End With
End Sub
Private Sub wdapp_MailMergeWizardSendToCustom(ByVal Doc As Document)
bCustomProcessing = True
Doc.MailMerge.Destination = wdSendToNewDocument
With Doc.MailMerge
For rec = 1 To .DataSource.RecordCount
.DataSource.ActiveRecord = rec
.DataSource.FirstRecord = rec
.DataSource.LastRecord = rec
.Execute
Next
End With
MsgBox "Merge Finished"
End Sub
Private Sub wdapp_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult As Document)
If bCustomProcessing = True Then
With Doc.MailMerge.DataSource.DataFields
sFirmFileName = .Item(44).Value ' First Column of the data - CHANGE
End With
DocResult.SaveAs "xxx\" & sFirmFileName & ".doc", wdFormatDocument
' Path and File Name to save. can use other formats like wdFormatPDF too
DocResult.Close False
End If
End Sub
You have to set your object as nothing like this :
Set DocResult = nothing

Excel Issue: Object Variable or with block Variable not set

I have a code that works for me about 70% of the time, the other times it throws the Error code 91 "Object Variable or With block Variable not set". If i click End and re-run it it will work fine.
The function is taking data that is entered into cells of an excel spreadsheet and populating text boxes, checking radio buttons, and selecting from drop-down lists on a webpage.
I can't post a link to the actual webpage for privacy issues but I'm hoping someone can help me why the error is coming up?
The line that shows the error is
drp.selectedIndex = Thisworkbook.sheets("sheet1").Range("L2").
Sub FillInternetForm()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
'set references for copying to submitted reps sheet and deleting for next rep
Application.ScreenUpdating = False
'create new instance of IE.
ie.navigate "removed for privacy"
'go to web page listed inside quotes
ie.Visible = True
While ie.busy
DoEvents 'wait until IE is done loading page.
Wend
'select onboarding system CRIS or ENS
Set html = ie.document
Dim drp As HTMLFormElement
Set drp = html.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = ThisWorkbook.Sheets("sheet1").Range("L2")
'set address nickname based on value
Set drp = html.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff32_1$ctl00 $Lookup")
drp.selectedIndex = ThisWorkbook.Sheets("sheet1").Range("m2")
'set market based on value
Set drp = html.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff6_1$ctl00$ DropDownChoice")
drp.selectedIndex = ThisWorkbook.Sheets("sheet1").Range("e2")
'check Not moved from another partner
ie.document.getElementById("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff46_1_ctl00_ctl01").Click
'input name and ssn based on excel sheet values
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff3_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("a2")
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff4_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("b2")
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff5_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("c2")
'input extra fields based on ICL value
'owner
ie.document.all("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff11_1_ctl00_ctl00_TextField").Value = ThisWorkbook.Sheets("sheet1").Range("j2")
'city
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff14_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("f2")
'state
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff15_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("g2")
'address
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff13_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("i2")
'phone
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff10_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("k2")
'zip
ie.document.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff16_1$ctl00$ctl00$TextField").Value = ThisWorkbook.Sheets("sheet1").Range("h2")
End Sub
While ie.busy is probably to blame. Use Loop Until ie.readyState = READYSTATE_COMPLETE instead.
I would cast .Range("L2") as an integer using CInt(.Range("L2")). You have a reference to the HTML Object library set. You should go ahead and add a reference to Microsoft Internet Controls. This way you'll get advantages of intellisense and internet constants. If you don't want to set the reference add Const READYSTATE_COMPLETE = 4 to the code and change the ie references back
Sub FillInternetForm()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Set ie = New InternetExplorer
'set references for copying to submitted reps sheet and deleting for next rep
Application.ScreenUpdating = False
'create new instance of IE.
ie.navigate "removed for privacy"
'go to web page listed inside quotes
ie.Visible = True
Do
DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE
With Sheets("sheet1")
'select onboarding system CRIS or ENS
Set doc = ie.document
Dim drp As HTMLFormElement
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = CInt(.Range("L2"))
'set address nickname based on value
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff32_1$ctl00 $Lookup")
drp.selectedIndex = CInt(.Range("m2"))
'set market based on value
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff6_1$ctl00$ DropDownChoice")
drp.selectedIndex = CInt(.Range("e2"))
'check Not moved from another partner
doc.getElementById("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff46_1_ctl00_ctl01").Click
'input name and ssn based on excel sheet values
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff3_1$ctl00$ctl00$TextField").value = .Range("a2")
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff4_1$ctl00$ctl00$TextField").value = .Range("b2")
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff5_1$ctl00$ctl00$TextField").value = .Range("c2")
'input extra fields based on ICL value
'owner
doc.all("ctl00_m_g_62853594_bb4b_4cec_8b5c_17fb6abb735e_ff11_1_ctl00_ctl00_TextField").value = .Range("j2")
'city
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff14_1$ctl00$ctl00$TextField").value = .Range("f2")
'state
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff15_1$ctl00$ctl00$TextField").value = .Range("g2")
'address
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff13_1$ctl00$ctl00$TextField").value = .Range("i2")
'phone
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff10_1$ctl00$ctl00$TextField").value = .Range("k2")
'zip
doc.all("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff16_1$ctl00$ctl00$TextField").value = .Range("h2")
End With
End Sub
I agree with #Thomas Inzina in that it's probably because the document hasn't fully loaded yet.
But I've found with my past projects that the best way to handle these 30% failure rates is to just "wait a bit longer" before processing or referring to elements.
Try adding a DoEvents and a Sleep command before you selectedIndex call.
See if it makes a difference
At the top of your module (before any subs are declared)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then add the two lines before you start set the doc variable
Doevents
Sleep 2000 ' Sleep two seconds (2000 ms)
Set doc = ie.document
You can play with the sleep value once you get a number that works for you
EDIT - added solution
A more reliable way is to actually run a loop that has DoEvents/Sleep and an incrementing counter for numTries. It exits the loop only when the check for getElementById doesn't fail - or your maxTries counter is reached.
Pretty simple loop but let me know if you need an example
EDIT - EXAMPLE: A wait until loaded loop
Change this
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = CInt(.Range("L2"))
To this:
Dim iTries As Integer
Dim iMaxTries As Integer ' it's better to turn this into a const at top of your sub
iMaxTries = 3
iTries = 0
While (iTries < iMaxTries) And IsNull(HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice"))
iTries = iTries + 1
DoEvents
Sleep 750 ' try 3/4 second delays to start with
Wend
If iTries = iMaxTries Then
MsgBox "Did not load HTML element in " & iMaxTries & " tries"
Exit Sub
End If
' Should all be loaded and ready to process now
Set drp = HTML.getElementById("ctl00$m$g_62853594_bb4b_4cec_8b5c_17fb6abb735e$ff45_1$ctl00 $DropDownChoice")
drp.selectedIndex = CInt(.Range("L2"))

Excel VBA Run Time Error '424' object required

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 )

Tabs, Ribbons, and Menus not responsive after VBA (Word 2007) generation of labels from IBM Notes

I am generating a set of labels using Word 2007, controlled via VBA from IBM Notes.
The document generates fine but after the generation the Tabs, ribbons and Menus are not responsive. I can click in the generated document but clicking on any of the top controls has no effect (icons do not press in, etc).
As a workaround I can click on another window, fiddle there, and then the ribbon for that particular document reacts. I am assuming that it has something to do with a focus problem.
After the code is finished, I am setting the Word Application.Visible to True, ScreenUpdating to True. I am calling a 'Close' to close all open files, but still, it's to no avail.
The code is being called by an IBM Notes Database in Lotusscript.
Have you encountered this before? It's very puzzling, and a no-go for my customers.
Andrew
Main Function:
Dim p As New LabelSourceFile
Call p.GenerateFileForSelectedDocuments()
Call p.ExtractWordTemplateFromConfig()
Dim w As New WordExport
w.setSelectedTemplateFullFile(p.FilePathToTemplate)
Print "file path to template: " + p.FilePathToTemplate
Call w.InitializeWordDocument()
Dim finaldoc As Variant
set finaldoc = w.MailMergeWithThisFile(p.getDataFileStreamFileName())
Call w.ReplaceCRWithCarriageReturns(finaldoc)
finaldoc.Activate 'gives focus back to document I've just generated
Set finaldoc = Nothing
'p.DeleteVorlage
'Kill p.FilePathToDataFile
Call w.ReleaseToUser()
This function initializes my document:
Public Function InitializeWordDocument As Integer
'Initialize a Word Document Object
' If m_strSelectedTemplateFullFile = "" an empty document is created
InitializeWordDocument = False
'On Error Goto ErrorHdl
m_objWordApplication.DisplayAlerts = wdAlertsnone
If Not m_objWordApplication Is Nothing Then
If m_strSelectedTemplateFullFile <> "" Then
Set m_objWordDoc = m_objWordApplication.Documents.Add( m_strSelectedTemplateFullFile )
InitializeWordDocument = True
Else
Set m_objWordDoc = m_objWordApplication.Documents.Add()
End If
Set m_objCurrentRange = m_objWordDoc.Range(0,0)
End If
m_objWordApplication.DisplayAlerts = wdAlertsAll
Exit Function
ErrorHdl:
InitializeWordDocument = False
Exit Function
End Function
This function is actually doing the merging:
'/*************************************************************************************
' * Function MailMergeWithThisFile
' * #param datafilename the data file
' * #return the final merged word document
' * #author Andrew Magerman/Magerman/NotesNet
' * #version Dec 18, 2013
' *************************************************************************************/
Function MailMergeWithThisFile (datafilename As String) As variant
On Error GoTo ErrorHandler
'If I don't block the popups, there is an annoying pop-up that appears.
m_objWordApplication.DisplayAlerts = wdAlertsnone
With me.m_objWordDoc.MailMerge
.MainDocumentType = wdFormLetters
Call .OpenDataSource(datafilename, wdOpenFormatText, false)
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute(False)
End With
'I need to set this here, immediately after the generation of the destination, merged document because the later
'actions of closing change the active document.
Set MailMergeWithThisFile = m_objWordApplication.ActiveDocument
Call m_objWordDoc.Close(False)
m_objWordApplication.DisplayAlerts = wdAlertsAll
Exit Function
ErrorHandler:
Call logError
Exit Function
End Function
By brainlessly commenting out lines until I got an answer, here is my workaround:
Always create a new instance (CreateObject) and forget about the GetObject.
If anyone has a good explanation for this, I'd be happy to hear it. For the moment I am just going to use the workaround.
'Initialize the Word Object
Set m_objWordApplication = Nothing
'I create always a new Word instance because that avoids me having focus issues.
' Set m_objWordApplication = GetObject("","word.application")
' If m_objWordApplication Is Nothing Then
Set m_objWordApplication = CreateObject("word.application")
' End If