VBA + Adobe Acrobat SDK - Unable to save an empty page? - vba

I am using VBA as a platform to do some PDF manipulation. The issue I am having is that I cannot seem to get the PDF object to save if the PDF object have not been opened. Below is a snippet of the code that inserts pages to the PDF object, and then saves the pdf object. In terms of the code, I have determined that it works since I have tested the save method with the same input with another pdf object and it worked just fine. Can someone help by explaining why it doesn't allow me to save the object?
Thanks!
Dim NewPDF As New Acrobat.AcroPDDoc
Set NewPDF = CreateObject("AcroExch.PDDoc")
If NewPDF.InsertPages(j, OriPDF, j, 1, 0) Then MsgBox "Success"
If NewPDF.Save(PDSaveLinearized, WritePath & "\" & sh.Cells(StartRow + j - 1, i).Value & ".pdf") Then MsgBox "Success"
NewPDF.Close
Set NewPDF = Nothing
When the above code was ran, neither of the success lines worked as expected.

Change line 3 to this...
If NewPDF.InsertPages(-1, OriPDF, j, 1, 0) Then MsgBox "Success"
The first parameter is the location after which the new pages get inserted but you have no pages because the document is empty so there is no page zero.

Related

Trying to save a pdf file of a screenshot of the form, given a specified location from the user's input

I am trying to save a created, PDF file to a location specified by the user. I'm using Visual Studio Community 2019. Essentially, I am taking a screenshot of this form:
And by using the PdfSharp external library, I create a PDF file and then save that PDF to some file location specified by the user. Here is the UI for the user to select their preferred file location:
The issue arises once the program tries to save the PDF file to the location given by the user. Here is the error I get from Visual Studio:
System.NotSupportedException: 'No data is available for encoding 1252. For information on defining a custom encoding, see the documentation for the Encoding.RegisterProvider method.'
I looked online for this specific error, but I don't really understand it nor what to do with it, it's very confusing. I'm still a bit of beginner when it comes to working with Visual Basic. Here's the code that tries to do it:
Dim fileLocation As String
fileLocation = folderBrowseBox.Text
GetFormImage(True).Save(fileLocation & "\" & RemoveWhitespace(filename) & "_" & RemoveWhitespace(collectionPeriod) & ".jpg", ImageFormat.Jpeg)
' Create new pdf document and page
Dim doc As New PdfDocument()
Dim oPage As New PdfPage()
' Add the page to the pdf document and add the captured image to it
doc.Pages.Add(oPage)
Dim img As XImage = XImage.FromFile(fileLocation & "\" & RemoveWhitespace(filename) & "_" & RemoveWhitespace(collectionPeriod) & ".jpg")
'Create XImage object from file.
Using xImg = PdfSharp.Drawing.XImage.FromFile(fileLocation & "\" & RemoveWhitespace(filename) & "_" & RemoveWhitespace(collectionPeriod) & ".jpg")
'Resize page Width and Height to fit image size.
oPage.Width = xImg.PixelWidth * 72 / xImg.HorizontalResolution
oPage.Height = xImg.PixelHeight * 72 / xImg.HorizontalResolution
'Draw current image file to page.
Dim xgr = PdfSharp.Drawing.XGraphics.FromPdfPage(oPage)
xgr.DrawImage(xImg, 0, 0, oPage.Width, oPage.Height)
End Using
doc.Save(fileLocation & "\" & RemoveWhitespace(filename) & "_" & RemoveWhitespace(collectionPeriod))
img.Dispose()
The second to last line of code ("doc.Save(fileLocation & ...)") is where the error occurs. The folderBrowseBox.Text (very first line of code) comes from the textbox you see from my second screenshot. Any help/advice will be greatly appreciated!
Try adding this line before writing the PDF file
System.Text.Encoding.RegisterProvider(System.Text.CodePagesEncodingProvider.Instance)
Got the idea from here

MS Word runs on background and requests documents to be saved even though it is already saved

I have a procedure that creates a PDF file according to an ms word template and its data is retrieved from a database.
It works fine, creates a PDF file perfectly , no run time errors. The problem is that whenever I shut off the computer, ms word prevents the shutdown and if I press cancel ms word shows a message;
The code goes like this;
Dim wordApp As Word.Application
Dim templateBookmarks As Word.Bookmarks
Dim templateName As String
Dim template As Word.Document
'Some other variables for computations
wordApp = CreateObject("Word.Application")
sourceTable = New DataTable
'Some other procs to fill the data table
templateName = "Foo Template.docx"
template = wordApp.Documents.Add(templatePath & templateName)
templateBookmarks = template.Bookmarks
templateBookmarks.Item("sample bookmark").Range.Text = "foo"
'Then fills the table in the template like...
template.Tables(1).Cell(1, 1).Range.Text = dataSource.Rows(0).Item(0)
'Then saves the document as a pdf
Dim saveName As String = "sample file"
template.SaveAs2(savePath & saveName, Word.WdSaveFormat.wdFormatPDF)
I have tried to force garbage collection for the word COM resources, as well as changing the template from an actual document i.e. docx to a word template .dotx. I also tried the method Quit() but it only shows the ms word message much earlier. This is the first time I needed to use interop so pardon if I don't have much idea about it.
The files I needed are saved, the only problem is the ms word message and unsaved and unnecessary files e.g. Document1,Document2,Document3 that seems to be created aside from the required PDF
Use the Document.Close method which closes the specified document after saving files using the PDF file format. It allows specifying the SaveChanges parameter which specifies the save action for the document. Can be one of the following WdSaveOptions constants: wdDoNotSaveChanges, wdPromptToSaveChanges, or wdSaveChanges.
On Error GoTo errorHandler
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
errorHandler:
If Err = 4198 Then MsgBox "Document was not closed"

MS Access VBA Dynamically Show Pics From URL

I found this code from here:
Show Pictures Directly From URLs in Access Forms and Reports
I have this code on my form:
Public Function PeopleImage()
'FUNCTION TO SET THE IMGPEOPLEPIC WITH THE CURRENT PERSON'S PHOTO, IF THE PHOTO CAN BE FOUND. OTHERWISE A STOCK IMAGE SAYING NO PIC FOUND WILL SHOW
Dim PeoplePic As String
Dim NoPeoplePic As String
Dim ImgDwnld As String
PeoplePic = "https://TheWebAddress.com/People%20Photos/" & Nz(Me.PersonID, 0) & ".jpg"
ImgDwnld = "\\AppServer\AppDir\Storage\Images\" & Nz(Me.PersonID, 0) & ".jpg"
DownloadFile PeoplePic, ImgDwnld, False
NoPeoplePic = "\\AppServer\AppDir\Storage\NoPeoplePic.jpg"
If FileExists(ImgDwnld) Then
Me.ImgPeoplePic.Picture = ImgDwnld
Else
Me.ImgPeoplePic.Picture = NoPeoplePic
End If
Me.ImgPeoplePic.Requery
End Function
When I added the image control ImgPeoplePic I set it to the NoPeoplePic, so that a picture would be set. Now, when I load the form and navigate, it looks like the photo is reloading (it blinks), but it just keeps showing the stock NoPeoplePic.
Anyone know what I'm missing? I feel like I'm so close. I just don't understand what it's not putting in the image that it downloads. I verified that the image downloads to the directory, and that it is there. I debug the path and image and it pulls up with no problem.
Any help is appreciated!

Runtime 91 when running from saved workbook

first time post here cause for the first time I couldn't find an answer on Stack.
The program I'm fiddling with goes to an API website - gets the passport key - and uses that to load the info in XML and then parses it. The code is very long so I'm only posting the bit that results in the error.
myURL = "https://api.smartbidnet.com/project?PassportKey=" & PassportKey & "&ResultType=xml" 'This is the API URL where we use our passport key to get our data
IE.Navigate myURL 'Go to Webpage
Dim XDoc As Object
Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False
XDoc.validateOnParse = False
XDoc.Load (ThisWorkbook.Path & myURL) 'Here we will load the XML info from the web page
Set lists = XDoc.DocumentElement 'lists will be used to access XML nodes
Set Projects = lists.SelectNodes("//root/projects")
Now heres the weird part:
If I open excel by selecting "Blank Workbook" the code works just fine from the editor.
If I save the blank workbook and then try to run it or If I simply right click the desktop and open a blank sheet rather than workbook and try to run it. the last line results in
Runtime 91 error
Any help is of course greatly appreciated.
The bit of code before the above is simply navigating to the site to grab the passport key for the API and build the myURL variable.

I am trying to use VBA code to save inkpicture contents, can only use vb.net or C#

I found this code that is missing the function call in the last line, any ideas on what the save to file command would be?, I'll just kludge it in.
'CODE to SAVE InkPicture to FILE
Dim objInk As MSINKAUTLib.InkPicture
Dim bytArr() As Byte
Dim File1 As String
File1 = "C:\" & TrainerSig & ".gif"
Set objInk = Me.InkPicture2.Object
If objInk.Ink.Strokes.Count > 0 Then
bytArr = objInk.Ink.Save(2)
fSaveFile bytArr, File1
End If
Here is a kludgy version of saving .InkPicture with VBA code in Access 2007 to a .isf file.
Private Sub Command283_Click()
'CODE to SAVE InkPicture to FILE
Dim objInk As MSINKAUTLib.InkPicture
Dim bytArr() As Byte
Dim File1 As String
File1 = "C:\test.isf"
Set objInk = Me.InkPicture2.Object
If objInk.Ink.Strokes.Count > 0 Then
bytArr = objInk.Ink.Save(2)
Open File1 For Binary As #1
Put #1, , bytArr
Close #1
End If
End Sub
I tried zaphod23's solution and it did not work for me. I also thought it quite strange that the solution would save in a .isf format, normally people want to save inkPicture contents to an image file (jpg, gif, etc.). It took me a while to hunt down the pieces of this code and put it together, so I'll post it here for others who might find it useful.
This takes an inkPicture object used for a signature panel in a Microsoft Access form, saves the contents as a gif image, then puts the image in an image object on the form (which is useful because the inkPicture contents will not show up when you go to print the form).
On Error Resume Next
Dim imgBytes() As Byte
Dim sFilePathAndName As String
imgBytes = Me.signaturePanel.Ink.Save(IPF_GIF)
If (UBound(imgBytes) = 0) Then
MsgBox ("Please enter your signature")
Else
sFilePathAndName = (Application.CurrentProject.Path & "\images\system\signatures\" & "signature")
Open sFilePathAndName For Binary Access Write As #1
Put #1, 1, imgBytes
Close #1
Me.imgSignature.Picture = sFilePathAndName
End If