I am trying to read one pdf and a VBA userform and then fill out another pdf.
I wrote code to read all text in a pdf and then find certain sub strings based on tokens that I can find in the string. It is intended to populate the fields in the destination pdf based on the substrings and check the appropriate text boxes based on the user form. I can get the code to fill the substrings and then save the document, but it won't check the boxes.
Before the code used a AVDoc, but I switched to a JSO because I don't want the pdf to pop up, and the jso avoids that problem.
I tried pdfBool.value = cBool(vbaBool), pdfBool.value = 1, pdfBool.value = "1", jso.setValue("checked"), jso.setValue("yes"), etc.
This code will run without crashing. I reduced the number of variables to one string and one bool for the sake of the example.
Sub main()
‘findString grabs all text from a pdf file. This code works.
Dim mystr As String
If findString(mystr) = False Then
Application.StatusBar = "Cannot find Source PDF"
Exit Sub
End If
Dim mypath As String
mypath = ActiveWorkbook.Path & "\destination.pdf"
Dim aApp As acrobat.AcroApp
Dim pdfDoc As acrobat.CAcroPDDoc
Dim jso As Object
Set aApp = CreateObject("AcroExch.App")
Set pdfDoc = CreateObject("AcroExch.PDDoc")
If pdfDoc.Open(mypath) = True Then
Set jso = pdfDoc.GetJSObject
Dim vbaText As String
Dim vbaBool As String
vbaText = returnString("Token1")
vbaBool = userForm.checkBox1.value
Dim pdfText As Object
Dim pdfBool As Object
Set pdfText = jso.getField("TextField1")
Set pdfBool = jso.getField("CheckBox1")
pdfText.Value = vbaText
pdfBool.Value = vbaBool
'save pdffile
Dim fileSavePath As String
fileSavePath = ActiveWorkbook.Path & "\My Save File.pdf"
pdfDoc.Save PDSaveFull, fileSavePath
'clean up memory
Set pdfDoc = Nothing
Set pdfText = Nothing
Set pdfBool = Nothing
Set jso = Nothing
End If
aApp.Exit
Set aApp = Nothing
Unload userForm1
End Sub
Ok, so after some searching, I have found a solution. Basically, forms created using Living Cycle don't work well with checkboxes. I asked somebody in my organization and they confirmed that Living Cycle was used on forms for a while until we got rid of it. Honestly, I don't know what Living Cycle is, but the solution seemed to work and so I think whatever the issue was related to something called "Living Cycle".
The solution? Redo the pdf form: I exported the pdf to an Encapsulated PostScript file. This stripped away all the fields. After that, I used the prepare form tool which automatically found all the relevant fields. Fortunately, with my pdf, it found all of the fields perfectly, though there was one or two extra ones that I had to delete. The field names and the code need to match so adjustments need to either be made to the PDF or to the code, but once I made that adjustment, everything was perfect.
Try jso.getfield(pdfFieldName).Value = "Yes" or "No". The value is case sensitive so you have to use Yes or No.
Related
I have a .CATdrawing template that I use to create drawings for all my parts.
My current macro opens the template as desired.
What I would like to do is to change the working name of the document so that when the user clicks "save" the correct name is already in the dialog box and he only needs to browse to the correct location.
To clarify I'll add an image: https://i.imgur.com/eckBwRQ.png
In this image the text "Drawing2" needs to change to whatever I want it to be.
I do not want to save the .CATdrawing at this moment, the user must be allowed to continue work and save the document when it suits him.
I've been doing some searches on google and in the V5Automation.chm but I can't seem to find the code that does this.
My best guess was to try the following code:
'remember currently opened part.
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim documents1 As Documents
Set documents1 = CATIA.Documents
'Open drawing
Dim mydrawingdoc As DrawingDocument
Set mydrawingdoc = documents1.Open("X:\Path\Template.CATDrawing")
'rename drawing
Set CATIA.ActiveDocument.Name = partDoc.Part.Parameters.Item("CUSTOM_NAME").ValueAsString
However I get an error saying
Invalid use of property
Any help would be greatly appreciated.
EDIT:
I've tried a few more things to do this but as of yet I've seen no success:
Left(mydrawingdoc.FullName, 10) = partDoc.Part.UserRefProperties.Item("CUSTOM_NAME").ValueAsString
this won't work either
EDIT2:
Ok so I found something that will give a completely different error:
mydrawingdoc.FullName = partDoc.Part.UserRefProperties.Item("CUSTOM_NAME").ValueAsString
Can't assign to read-only property
Does this mean it's impossible to do what I want?
Could a possible solution be to use NewFrom instead of Open like this:
Set mydrawingdoc = documents1.NewFrom("path\Template.CATDrawing")
And then immediately use the desired name while creating this drawingdocument?
It is not possible to change the name of a top-level document that has not been saved yet.
The best and only workaround, as far as I could find, is saving the document with the correct name in a temporary folder.
Example:
'remember currently opened part.
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim documents1 As Documents
Set documents1 = CATIA.Documents
'Open drawing
Dim mydrawingdoc As DrawingDocument
Set mydrawingdoc = documents1.NewFrom("path\Template.CATDrawing")
'Save drawing with custom name extracted from 3D part
CATIA.ActiveDocument.SaveAs ("C:\CATIA_temp\" & partDoc.Product.UserRefProperties.Item("CUSTOM_NAME").ValueAsString & ".CATDrawing")
The code below reads and inserts the email from lotus notes to an excel sheet. However I would like to read a lotus notes database and copy its content and paste it as a rich text into a word document.
I assume this line of code needs to be modified.
Set nitem = .GetFirstItem("Body")
What would be the best way to go about this?
Public Sub Lotus_Notes_Current_Email4()
Dim NSession As Object 'NotesSession
Dim NUIWorkSpace As Object 'NotesUIWorkspace
Dim NUIdoc As Object 'NotesUIDocument
Dim nitem As Object 'NotesItem
Dim lines As Variant
Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set NUIdoc = NUIWorkSpace.CurrentDocument
If Not NUIdoc Is Nothing Then
With NUIdoc.Document
Set nitem = .GetFirstItem("Body")
If Not nitem Is Nothing Then
lines = Split(nitem.Text, vbCrLf)
Sheets(1).Activate
Range("H8").Resize(UBound(lines) + 1, 1).Value = Application.WorksheetFunction.Transpose(lines)
End If
End With
Else
MsgBox "Lotus Notes is not displaying an email"
End If
Set NUIdoc = Nothing
Set NUIWorkSpace = Nothing
Set NSession = Nothing
End Sub
Your assumption is incorrect. Your entire script needs to be rewritten.
If you want to copy the contents of a view, then you need to start by opening a NotesView object. Your current code is opening a NotesDocument object. To get the NotesView, you might want to use the CurrentView property NotesUIWorkspace to get a NotesUIView object, and then use that objects View property.
Once you have the NotesView object, then I'm guessing you might want to want to use the columns property to get at the data, but there are other ways you could go about it. Pretty much no matter what you do, though, you're going to have to handle the formatting of the data on your own.
I'm getting this error, "Microsoft Excel is waiting for another application to complete an OLE action" when trying to automate a PDF string search and record findings in excel. For certain PDFs this error is not popping. I assume this is due to the less optimized PDFs taking a longer time to search string while indexing page by page.
To be more precise, I have a workbook containing two sheets. One contains a list of PDF file names and the other has a list of words that I want to search. From the file list the macro would open each PDF file and take each word from the list of words and perform a string search. If found it would record each finding in a new sheet in the same workbook with the file name and the found string.
Below is the code I'm struggling with. Any help is welcome.
Public Sub SearchWords()
'variables
Dim ps As Range
Dim fs As Range
Dim PList As Range
Dim FList As Range
Dim PLRow As Long
Dim FLRow As Long
Dim Tracker As Worksheet
Dim gapp As Object
Dim gAvDoc As Object
Dim gPDFPath As String
Dim sText As String 'String to search for
FLRow = ActiveWorkbook.Sheets("List Files").Range("B1").End(xlDown).Row
PLRow = ActiveWorkbook.Sheets("Prohibited Words").Range("A1").End(xlDown).Row
Set PList = ActiveWorkbook.Sheets("Prohibited Words").Range("A2:A" & PLRow)
Set FList = ActiveWorkbook.Sheets("List Files").Range("B2:B" & FLRow)
Set Tracker = ActiveWorkbook.Sheets("Tracker")
'For each PDF file list in Excel Range
For Each fs In FList
'Initialize Acrobat by creating App object
Set gapp = CreateObject("AcroExch.App")
'Set AVDoc object
Set gAvDoc = CreateObject("AcroExch.AVDoc")
'Set PDF file path to open in PDF
gPDFPath = fs.Cells.Value
' open the PDF
If gAvDoc.Open(gPDFPath, "") = True Then
'Bring the PDF to front
gAvDoc.BringToFront
'For each word list in the range
For Each ps In PList
'Assign String to search
sText = ps.Cells.Value
'This is where the error is appearing
If gAvDoc.FindText(sText, False, True, False) = True Then
'Record findings
Tracker.Range("A1").End(xlDown).Offset(1, 0) = fs.Cells.Offset(0, -1).Value
Tracker.Range("B1").End(xlDown).Offset(1, 0) = ps.Cells.Value
End If
Next
End If
'Message to display once the search is over for a particular PDF
MsgBox (fs.Cells.Offset(0, -1).Value & " assignment complete")
Next
gAvDoc.Close True
gapp.Exit
set gAVDoc = Nothing
set gapp = Nothing
End Sub
I have now found the answer to this problem.
I'm using Acrobat Pro and whenever I open a PDF file, it opens with limited features due to Protected View settings. If I disable this function or if I click Enable All Features and save changes to the PDF files, VBA macro runs smooth.
It's funny, I'm posting an answer to my own problem.
Thanks in advance for any help you can give me.
I'm trying to create a VB application that will open an existing Word document, make some changes and save it with a new file name. Making the changes to the document is easy. Saving the document seems like it should be just as easy but there is one serious problem. When I try to save the document, the save as dialog opens. This is supposed to be automated so that doesn't work. I have tried a whole bunch of variations of:
Sub Main()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim fileName As String
Dim templateName As String
Dim newFileName As String
'Start Word and open the document template.
oWord = CreateObject("Word.Application")
oWord.Visible = False
oWord.DisplayAlerts = Word.WdAlertLevel.wdAlertsNone
templateName = "C:\tmp\template.dotx"
fileName = "C:\tmp\document.docx"
newFileName = "C:\tmp\new document.docx"
oDoc = oWord.Documents.Add(templateName)
'oDoc = oWord.Documents.Open(fileName) I have tried both using a template and opening a docx file.
<make changes>
oDoc.SaveAs2(newFileName)
oWord.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
oWord.Application.Quit()
oWord = Nothing
End Sub
It always stops here:
oDoc.SaveAs2
and opens the save as dialog. I need to find a way to suppress the save as dialog or a new way of editing the word files. Everything I have found so far about the problem has either not been solved/updated or was related to Word addins. I don't have any of the addins that people said caused the problem. To be safe, I disabled all word addins.
I would appreciate it if anyone has either solved it or has a different approach. I'm not stuck on the idea of using VB. The only reason I'm going this route is because I think it gives me the best library for editing charts and formatting the documents.
Thanks, Steve
I found the problem. The answer lies in what I was doing in the part I omitted where I was making changes to the document. Part of those changes are to update data in the charts in the document. I had something like:
For Each oShape As Word.InlineShape In oDoc.InlineShapes
If oShape.HasChart And oShape.Range.Bookmarks.Item(1).Name = "ChartName" Then
Console.WriteLine("Updating ChartName")
Dim oWorkbook As Excel.Workbook
oWorkbook = oShape.Chart.ChartData.Workbook
oWorkbook.Worksheets(1).Range("B2").FormulaR1C1 = "9"
oWorkbook.Worksheets(1).Range("B3").FormulaR1C1 = "5"
oWorkbook.Worksheets(1).Range("B4").FormulaR1C1 = "1"
oWorkbook.Application.Quit()
End If
Next
I changed it to:
For Each oShape As Word.InlineShape In oDoc.InlineShapes
If oShape.HasChart And oShape.Range.Bookmarks.Item(1).Name = "ChartName" Then
Console.WriteLine("Updating ChartName")
Dim oWorkbook As Excel.Workbook
oWorkbook = oShape.Chart.ChartData.Workbook
oWorkbook.Worksheets(1).Range("B2").FormulaR1C1 = "9"
oWorkbook.Worksheets(1).Range("B3").FormulaR1C1 = "5"
oWorkbook.Worksheets(1).Range("B4").FormulaR1C1 = "1"
oShape.Chart.Refresh()
oWorkbook.Close(True)
End If
Next
Now it works
myDoc.SaveAs(fileNameAndPath)
Works for me in Word 2007
I'm trying to write a Excel VBA code which allows me to automatically create and send a Lotus Notes Email. The problem I face is the difficulty to create a rich text Email, so I think it would be easier to open a draft email, with a marker text which will be replaced (for exameple PASTE EXCEL CELLS HERE) and then just:
.GotoField ("Body")
.FINDSTRING "PASTE EXCEL CELLS HERE"'
and replace.
Any help on how to open a certain draft email? Perhabs something as .CreateDocument property?
Thank you very much!
Others have proposed interesting concepts, but the most robust approach would be to use HTML in a MIME enitity that is mapped to the Body Rich Text item. Using NotesSession..Convertmime = False you can build the body as HTML and then send the message. Based on the post by Joseph Hoetzl here, the LotusScript equivalent is this:
Sub Initialize()
Dim s As New NotesSession
Dim db As NotesDatabase
Dim stime as Single
Dim alog As New NotesLog("debug")
Call alog.OpenAgentLog()
stime = Timer
On Error GoTo eh
Dim doc As NotesDocument
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim stream As NotesStream
Dim child As NotesMIMEEntity
Dim sendTo As String
Dim subject As String
s.Convertmime = False
sendto = s.Effectiveusername
subject = "Demo Message"
Set db= s.Currentdatabase
Set doc=db.Createdocument()
Set stream = s.CreateStream
Set body = doc.CreateMIMEEntity
Set header = body.CreateHeader({MIME-Version})
Call header.SetHeaderVal("1.0")
Set header = body.CreateHeader("Content-Type")
Call header.SetHeaderValAndParams({multipart/alternative;boundary="=NextPart_="})
'Add the to field
Set header = body.CreateHeader("To")
Call header.SetHeaderVal(SendTo)
'Add Subject Line
Set header = body.CreateHeader("Subject")
Call header.SetHeaderVal(subject)
'Add the body of the message
Set child = body.CreateChildEntity
Call stream.WriteText("<h1>Demo HTML Message</h1>")
Call stream.WriteText(|<table colspacing="0" colpadding="0" border="none">|)
Call stream.WriteText(|<tr><td>cell 1.1</td><td>cell 1.2</td><td>cell 1.3</td></tr>|)
Call stream.WriteText(|<tr><td>cell 2.1</td><td>cell 2.2</td><td>cell 2.3</td></tr>|)
Call stream.WriteText(|<tr><td>cell 3.1</td><td>cell 3.2</td><td>cell 3.3</td></tr>|)
Call stream.WriteText(|</table>|)
Call stream.WriteText(|<div class="headerlogo">|)
Call stream.WriteText(|<!-- ...some more HTML -->|)
Call child.setContentFromText(stream, {text/html;charset="iso-8859-1"}, ENC_NONE)
Call stream.Truncate 'Not sure if I need this
Call stream.Close
Call doc.CloseMIMEEntities(True)
Call doc.replaceItemValue("Form", "Memo")
Call doc.Send(False, sendTo)
es:
Exit Sub
eh:
Dim emsg$
emsg = Error & " at " & Erl & " in " & s.Currentagent.name
Call alog.logError(Err, emsg)
MsgBox "ERROR: " & Err & ": " & emsg
Resume es
End Sub
All of this should convert fairly easily to VBA in Excel. You can, of course be as complex as you want with your HTML.
The word "draft" is probably inappropriate here, but then again so is the word "template". Both have specific meanings in Lotus Notes that aren't what you really want. Users can delete drafts, and templates are an entirely different thing. So let's just call it a boilerplate message.
I would recomemnd creating a special mail database (NSF file) on the Domino server, which will just serve as a repository for your boilerplate. You can create a folder in that mail database called "Boilerplates". Using Domino Designer you can modify that folder's design so that the Subject column is the first column in the view, and it is sorted.
Once you have that done and you have created some boilerplates and saved them in the folder, you can use VBA to do a NotesSession.getDatabase call, NotesDatabase.getView call (this is used for folders as well as views), and then use NotesView.getDocumentByKey() to retrieve a specific boilerplate by the Subject you have assigned to it. Note that you do not have to copy this document to the user's mail database in order to mail it.
What you want to do is non-trivial, but you mention a draft email so there may be a workaround.
In your mail settings you can specify a signature file which can be an external html file on disk. So modify the signature file, then create your new mail which will then populate the body field the way you want it.
For sample code, within the memo form there should be a button to specify what signature file to use. You can use that as the baseline.
Rich text is not that hard to work with, but you need to look at the Domino Designer help, especially the classes NotesRichTextItem and NotesRichTextStyle. You also need to understand the DOM (Domino Object Model). Then you can create your mail content programatically.
Otherwise I think Richard's solution is the best, that you have a separate database where you get the rich text snippets, and use the AppendRTItem method of the NotesRichText class to put it into your email.
Thank you all guys!
But I found exactly what I wanted, without having to recreate the whole Email everytime:
Sub EditSelectedMail()
Dim NSession As Object
Dim NDatabase As Object
Dim NUIWorkspace As Object
Dim NUIdoc As Object
Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then NDatabase.OPENMAIL
Set NUIdoc = NUIWorkspace.EDITDOCUMENT(True)
With NUIdoc
'Find the marker text in the Body item
.GotoField ("Body")
.FINDSTRING "**PASTE EXCEL CELLS HERE**"
'Copy Excel cells to clipboard
Sheets("Sheet1").Range("A1:E6").Copy
'Create a temporary Word Document
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
WordApp.Documents.Add
'Paste into Word document and copy to clipboard
With WordApp.Selection
.PasteSpecial DataType:=10
'Enum WdPasteDataType: 10 = HTML; 2 = Text; 1 = RTF
.WholeStory
.Copy
End With
'Paste from clipboard (Word) to Lotus Notes document
.Paste
Application.CutCopyMode = False
'WordApp.Quit SaveChanges:=False
Set WordApp = Nothing
End With
End Sub
I just select my "template", copy it into a new message, and then run the macro.