I want to edit a pdf file attached as an object to my Excel doc with VBA.
Background: Since I don't want to share both files in a .zip or else and there is no network drive everybody has granted access to, I need a "foolproof" solution.
The pdf file contains a form (mandatory) and will be filled with information from this Excel doc. As mentioned, I already had a solution with the pdf file stored on a network drive.
Dim file, new_name As String
Set AcroApp = CreateObject("AcroExch.App")
Set AvDoc = CreateObject("AcroExch.AVDoc")
'Open new PDF file
'Use local path
file = "C:\Users\992\Desktop\example.pdf"
new_name = "New_PDF_12092019"
If AvDoc.Open(Datei, Name) Then
AcroApp.Show
Set PDDoc = AvDoc.GetPDDoc()
Set jso = PDDoc.GetJSObject
'Get cart ID
jso.getField("Feld1").Value = CStr(ActiveSheet.Range("B12").Value)
'Get Project ID
jso.getField("Feld2").Value = CStr(ActiveSheet.Range("B14").Value)
...
My question is: is there any possibility to use an embedded object with AcroExch.AVDoc?
Since parameter szFullPath requires the full path of the file to open, I thought about getting the "path" of the object and use it - but I cannot figure out how. Already tried this: https://danny.fyi/embedding-and-accessing-a-file-in-excel-with-vba-and-ole-objects-4d4e7863cfff
Maybe someone can help me with this.
Thanks in advance!
Related
Been using this code for a while to upload a file to SharePoint and noticed the other day that when the file is uploaded, it is checked out to myself automatically and have to go into SharePoint and manually check-in so that others can view the file. Any way to modify or add to my code below to auto check-in a file after it uploads? Totally stumped and any help would be greatly appreciated.
Sub SharePointUpload()
Dim WSN
Dim spAdd
Set WSN = CreateObject("WScript.Network")
spAdd = "https://mysharepoint/test"
WSN.mapnetworkdrive "N:", spAdd
ActiveWorkbook.Save
Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object
' Where you will enter Sharepoint location path
SharepointAddress = "\\mysharepoint\test"
' Where you will enter the local file path
LocalAddress = "C:\data\sample_file.xlsm"
Set objNet = CreateObject("WScript.Network")
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists(LocalAddress) Then
FS.CopyFile LocalAddress, SharepointAddress
Else: MsgBox "File does not exist!"
End If
Set objNet = Nothing
Set FS = Nothing
WSN.removenetworkdrive "N:"
End Sub
I had the same issue with our SharePoint Document library even with option Require Check Out switched off - some documents (Word, Excel) were uploaded as Checked Out automatically (green arrow mark) whereas others were in fact Checked In from upload. Moreover when I wanted to Check In manually such documents, I got error message about missing mandatory field, although there was no field in the library set as mandatory.
The reason in my case was the field Title. This field is presented in library as default text field and it is also presented in Office files. I noticed that for Office files with empty field Title the document is automatically Checked Out during upload. When uploaded document contained some text in Title property, no Check Out was set. I also tried to use workflow to change the Title and then Check Out file (after creation), but it was not working - initial Check In was required to start the workflow. Manual change of document properties works but that's too tedious...
The first programmatic option to handle this issue could be to fill Title property of uploaded document when empty (i.e. add file name or any other text). Should work well with many languages. Example with Python:
from docx import Document
path = 'D:/myfile.docx'
document = Document(path)
document_property = document.core_properties
if not document_property.title:
document_property.title = 'Everything is Awesome'
document.save(path)
In VBA Title should accessible via Wb.BuiltinDocumentProperties("Title").
Another successful option for me was to find column Title in Columns of Document library and rename it to something else (I used Titlex as new name), then try to upload new document with empty Title - this time there was no automatic Check Out for the uploaded document. Then I could set the Titlex back to Title without returning the issue.
I'm trying to fill out template PDF with data from excel worksheet using VBA and here's what I have so far;
FILE_NAME_TEMPLATE = "path_to\template.pdf"
Set gApp = CreateObject("AcroExch.app")
Set avDoc = CreateObject("AcroExch.AVDoc")
If avDoc.Open(FILENAME, "") Then
Set pdDoc = avDoc.GetPDDoc()
Set jso = pdDoc.GetJSObject
'populating pdf fields here, no issues
FILE_NAME_RESULT = "path_to\result.pdf"
pdDoc.Save PDSaveFull, FILE_NAME_RESULT
pdDoc.Close
End If
avDoc.Close (True)
As is, code populates and saves template.pdf, however I'd like to leave template file unchanged and create the new result.pdf with populated data. Please explain what am I doing wrong and thank you for your time.
(Not enough points to just comment yet, so posting as an answer instead)
Is pdDoc.Close a Function and if so, what's its return value?
As a workaround, you could copy the template to the result file first and then work on the file.
FileCopy FILE_NAME_TEMPLATE, FILE_NAME_RESULT
Let me add a coding style best practice recommendation: use all upper-case names for constants only. For actual variables, use mixed case names (like you did with e.g. pdDoc.
I was looking for this too and it took me days: Just use the document flag (long) instead of the argument:
pdDoc.Save 1, FILE_NAME_RESULT
I have found some answers/examples here on stackoverflow for an issue where in Microsoft Excell 2010, I want to create a txt files for each cell from for e.g. ColumnA which would contain file names, and ColumnB which would contain what is inside certain text file, however one example doesn't work at all, and second bugs after few files created.
You can use the CreateTextFile method which will create your file and provide a TextStream object which you can use to write to the text files. Microsoft Docs
Here's a code example that will do what you asked.
Sub CreateTxt()
Dim my_range As Range
Dim pth As String
Set my_range = Selection
For Each x In my_range.Rows:
pth = "C:\excel_test\" + x.Cells(1) + ".txt" 'file name in column A
Set file_sys = CreateObject("Scripting.FileSystemObject")
Set txt_file = file_sys.CreateTextFile(pth, True)
txt_file.WriteLine (x.Cells(2)) 'content in Column B
txt_file.Close
Next x
End Sub
Just remember, in order to create a file you need adequate permissions on the path you're writing to - I had to run excel as administrator to get the functionality.
Also, the True value in the CreateTextFile method is necessary to overwrite any files with the existing file name, if set to false it will throw an error when trying to write to the file.
I am currently using Outlook 2010 and I am currently able to manually search a folder in outlook by using the "More" button and adding attachments:yes and attachment contains: where I input the filename to find an email and get the timestamp from when it was sent. I have thousands of attachments for which I need to do this and I would like to automate the process but I am an outlook vba noobie and I do not know the command to perform the search by attachment name, I have tried googling this but to no avail any help would be greatly appreciated thanks!
You can use Restrict https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
Example here: http://www.jpsoftwaretech.com/save-all-attachments-from-selected-folder/
Set newItems = itms.Restrict("[Attachment] > 0")
Combined with:
attName = MsgAttach.Item(attachmentNumber)
If InStr(attName, "search string here") Then
Debug.Print "- " & attName
End If
Outlook Object Model will not let you search for an item with a particular attachment file name. You can explicitly loop through all items in the folder and check the attachment filename, but that will be highly inefficient.
On the Extended MAPI level (C++ or Delphi) you can create a subrestriction on the attachments. If using Redemption is an option (I am its author), it allows to specify Attachments in RDOItems.Find/Restrict:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set vFolder = Session.GetFolderFromID(Application.ActiveExplorer.CurrentFolder.EntryID)
set vItems = vFolder.Items
set vMsg = vItems.Find("Attachments LIKE '%.zip%' ")
while not (vMsg Is Nothing)
MsgBox vMsg.Subject
set vMsg = vItems.FindNext
wend
I have found plenty of vba for inserting images into a comment
Selection.ShapeRange.Fill.UserPicture "C:\Temp\Pictures\ewe.jpg"
How can you determine the image already used for an comment?
I would like to extract the embedded image names if possible.
Is there not a property to access that will give me this?
In the comment Fill Effects dialog box the image name somehow seems to be accessible.
Sorry, I didn't have the reputation to just comment on your question for clarification.
I made a test file, inserted a comment and image in that comment, and then extracted the base files. I then checked them all for the original file name. I also found the embedded JPEG and decoded it to get the metadata. As you've noted, the original file names are stored in xl\drawings\vmlDrawing1.vml (once you've extracted the xml files from the excel file by appending .zip to the filename and then running an unzip utility on it). I did find the file name, but not the path or file type, so I'm fairly certain that the path and file type aren't preserved.
If just the file name is sufficient for you, then that file contains information for each drawing that you have, and those will include the cell location, although they're 0 based, so you'd have to add one to get the actual row and column. My question is two part:
1) Is the file name alone sufficient, or did you need the entire path? If you needed the entire path, I think you're out of luck, since the paths are on a different computer and you can't even search for them if you do extract the file name.
2) If that is all you need, does the solution have to be VBA? In the past, I have programmatically unzipped and manipulated the xml base files, but it's a little tricky. It's simplified by the fact that you only have to read out the data, so that's a plus. I did it in .net before, but I'm sure that if it had to be VBA it could be done, but it would be simpler if you were open to the type of solution.
Let me know, I'd be happy to help you out.
====================================================================================
Try this: make a copy of the spreadsheet, append .zip (test.xlsm.zip), and then extract the files manually. Change vmlPath to the location of your xl\drawings\vmlDrawing1.vml file. Then run this. I did make some assumptions, for instance, I assumed that the order of the nodes and attributes would always be the same and so I used hardcoded indexes (shp.attributes(0), etc) instead of using logic to make sure I had the correct node or attribute, but you seem like you know your way around VBA, so I'm just going to code a barebones. This will need a reference to Microsoft XML 6.0.
Sub vmlParse()
Dim vmlPath As String: vmlPath = "C:\Users\Lenovo\Desktop\test - Copy.xlsm\xl\drawings\vmlDrawing1.vml"
Dim this As Worksheet: Set this = ActiveSheet
Dim doc As New DOMDocument, shps As IXMLDOMNodeList
Dim shp As IXMLDOMNode, n As IXMLDOMNode, a As IXMLDOMAttribute
Dim fileName As String, productID As String
Dim rng As Range, r As Long, c As Long
doc.Load vmlPath
Set shps = doc.getElementsByTagName("x:ClientData")
For Each shp In shps
If shp.Attributes(0).nodeValue = "Note" Then
r = 0: c = 0
For Each a In shp.ParentNode.FirstChild.Attributes
If a.nodeName = "o:title" Then
fileName = a.nodeValue
Exit For
End If
Next
For Each n In shp.childNodes
If n.nodeName = "x:Row" Then r = n.text
If n.nodeName = "x:Column" Then c = n.text
Next
Set rng = this.Cells(r + 1, c + 1)
productID = rng.Value
'now you have the productID, the fileName, and the cell location
End If
Next
End Sub
Let me know how that worked out for you.
If c4 contains your comment:
Set shp = Range("C4").Comment.Shape
if shp.Fill.TextureType = msoTextureUserDefined then
end if