open xlsx in libreoffice macro - vba

I am trying to open an excel file from libreoffice calc's macro but I keep coming accross errors. This is my first time using libreoffice macro.
Here is my first attempt, was from a website where someone asked the same question so I tried there code: https://forum.openoffice.org/en/forum/viewtopic.php?f=5&t=17075
Target = "C:\Users\RKerrigan\Documents\Scripts\Mailerreportgenerator\Miller Radiology Mailers Template.xlsx"
TargetURL = convertToURL(Target)
Empty() = Array()
TestDoc = StarDesktop.loadComponentFromURL(TargetURL, "_blank", 0, Empty())
But the error I got was regarding line 6 (Empty() = Array()):
BASIC runtime error.
'382'
This property is read-only.
So then I searched around and found this link from stackoverflow: https://stackoverflow.com/a/65201568/16953756
Which brings you to this example:https://help.libreoffice.org/6.4/en-US/text/sbasic/shared/stardesktop.html
Dim docURL As String
Dim doc As Object, docProperties()
docURL = ConvertToURL("C:\\Users\\RKerrigan\\Documents\\Scripts\\Mailerreportgenerator\\Miller Radiology Mailers Template.xlsx")
Rem com.sun.star.frame.Desktop
doc = StarDesktop.LoadComponentFromURL(docURL, "_blank", 0, docProperties)
But I got another error saying:
BASIC runtime error.
'1'
Type: com.sun.star.lang.IllegalArgumentException
Message: Unsupported URL <file:///C://Users//RKerrigan//Documents//Scripts//Mailerreportgenerator//Miller%20Radiology%20Mailers%20Template.xlsx>: "type detection failed"
Can someone help me open this file in libreoffice macro? "C:\Users\RKerrigan\Documents\Scripts\Mailerreportgenerator\Miller Radiology Mailers Template.xlsx"
I thought it was something quotes so I tried double slashes and that didn't work either.

Please try
Sub OpenRadiologyMailers()
Dim sFilename As String
Dim oSourceSpreadsheet As Variant
sFilename = ConvertToURL("C:\Users\RKerrigan\Documents\Scripts\Mailerreportgenerator\Miller Radiology Mailers Template.xlsx")
If Not FileExists(sFilename) Then
MsgBox("File not found!")
Exit Sub
EndIf
GlobalScope.BasicLibraries.loadLibrary("Tools")
oSourceSpreadsheet = OpenDocument(sFilename, Array())
If IsEmpty(oSourceSpreadsheet) Then
MsgBox("The file may be open in another application",0,"Failed to load file")
Exit Sub
EndIf
' ... further actions with the document oSourceSpreadsheet
End Sub

Related

Cannot mark Excel workbook as Final

The situation is as follows:
We want to publish to a remote machine a locally edited file. This file could be of type Word, Excel, Powerpoint. Apparently, after the publishing to the remote machine, we would like the local document to be marked as final, in order to prevent the user from editing it again (, because the intented workflow is first downloading it from the remote server, editing the downloaded document and the publishing it back to the server).
So, there is a bunch of code like this:
Public Sub setDocFinal()
Select Case addin.HostType
Case ADXOfficeHostApp.ohaWord
Dim doc As Word.Document = Nothing
Try
doc = addin.WordApp.ActiveDocument
doc.Final = True
Catch ex As Exception
Throw New Exception(Me.addin.getLabel("cannotSaveCopy", "Cannot Save the document."))
Finally
Marshal.ReleaseComObject(doc)
End Try
Case ADXOfficeHostApp.ohaExcel
Dim doc As Excel.Workbook = Nothing
Try
doc = addin.ExcelApp.ActiveWorkbook
doc.Final = True
'doc.RefreshAll()
'doc.CalculateUntilAsyncQueriesDone()
'doc.Calculate()
Catch ex As Exception
Throw New Exception(Me.addin.getLabel("cannotSaveCopy", "Cannot Save the document."))
Finally
Marshal.ReleaseComObject(doc)
End Try
' Powerpoint case intentionally skipped as is has same format/code
End Select
End Sub
The above code works pretty well for the Word case, but when it comes to Excel, it stacks on the popup which informs the user for the publish action to the remote server:
EDIT
At that particular point, the execution freezes (or maybe gets into an infinite internal loop, because the only available buttons in debugging mode are pause and stop) at the line of setting the document as final and it never reaches the finally statement (where we release the object). It also seems like the execution tries to return control back to the excel document, but nothing more than this notification occurs :
Any idea of what is wrong in the above code, regarding the handling of Excel?
The lines in comments display some trials I have been going through, while trying to find a solution around the net.
In addition, here is also the popup's related code:
Private Sub doWork(ByVal action As String, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim myDoc As MyDocument
myDoc = DirectCast(e.Argument, MyDocument)
System.Diagnostics.Debug.WriteLine("Post in Thread")
Dim resultObject(3) As Object
resultObject(0) = True
resultObject(1) = myDoc
Dim saveDocumentResult As SaveDocumentResult = Nothing
Try
Select Case action
Case Constants.SAVE_DRAFT
saveDocumentResult = myDoc.getRequestService().saveDraft(myDoc.getSaveFile(), myDoc.getDocName(), myDoc)
Case Constants.PUBLISH
saveDocumentResult = myDoc.getRequestService().publishDocument(myDoc.getSaveFile(), myDoc.getDocName(), myDoc)
myDoc.setDocFinal() 'this line makes the call to the above code
End Select
myDoc.updateDocumentProperty(Constants.VERSION, saveDocumentResult.version)
myDoc.updateDocumentProperty(Constants.HASH, saveDocumentResult.hash)
myDoc.setSaved(True)
System.Threading.Thread.Sleep(1500)
Catch ex As Exception
resultObject(0) = False
resultObject(2) = ex.Message
Finally
e.Result = resultObject
End Try
End Sub

NotesDocument.save() causing loss of rich text formatting

I have following code in an lotusscript agent that removes attachments from NotesDocuments. But NotesDocument.save() causes loss of rich text formatting (font, color). Is there any way to retain the formatting?
Sub removeAttachments_v2(doc As NotesDocument)
Dim session As NotesSession
Dim rtitem As Variant
Dim filename As String
Dim ans As Variant
Set session = New NotesSession
Dim richstyle As NotesRichTextStyle
Set richstyle = session.CreateRichTextStyle
richstyle.NotesColor = COLOR_BLUE
If doc.HasEmbedded Then
Set rtitem = doc.getfirstitem("Body")
If (rtitem.type = RICHTEXT) Then
ForAll object In rtitem.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT) Then
filename = object.source
Call object.remove
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendStyle(richstyle)
Call rtitem.AppendText( "Attachemnt removed: " & filename )
Call doc.Save( True, True , True )
End If
End ForAll
End If
End If
End sub
Edit1: Initialize function
Sub Initialize
Dim db As New NotesDatabase("","")
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Call db.Open("", "C:\this\is\db\dir\test.nsf")
Set col = db.Alldocuments
Set doc = col.Getfirstdocument()
While Not ( doc Is Nothing )
Call RemoveAttachments_v2(doc)
Call doc.Save(False, False, False)
Set doc = col.GetNextDocument( doc )
Wend
End Sub
Despite of the fact, that you save the document for every attachment I cannot find any reason, why this should happen. I just copied your code in an agent, and it removes the attachments as desired and appends the text in blue...
No formatting is lost...
The error has to be somewhere else in your code, probably in the calling function.
OLD ANSWER (wrong due to own tests, just kept here as history):
The Problem here most probably is: you defined rtitem as Variant. And
getfirstitem gets you a NotesItem instead of a NotesRichtextItem, so
when saving, it is converted to a "plain Text" item.
Most probably you used Variant instead of NotesRichtextItem, because
there are Mime- mails where defining the variable as NotesRichtextItem
will cause an "Type Missmatch" or similar error. As long as you do not
write anything back this is OK.
As Mime Mails need complete different handling to achieve your goal,
you should first fix the code for pure NotesRichtextItems by using the
right type, and then write another code- branch for handling Mime-
items

How do I copy a file to the clipboard and paste it somewhere else?

I have a listview with small thumbnails of images.
Each image has a tag with it's full path in it.
With a rightclick menu the user can click COPY.
Then this code is excecuted:
Dim selectedfile As String
selectedfile = Me.lvFotos.SelectedItems(0).Tag
Dim dataobj As New DataObject(DataFormats.FileDrop, selectedfile)
Clipboard.Clear()
Clipboard.SetDataObject(dataobj)
Now when I click on my desktop to paste the file I get an exception error in VS2010:
An exception of type 'System.Runtime.InteropServices.COMException' occurred in System.Windows.Forms.dll and wasn't handled before a managed/native boundary
Additional information: Invalid FORMATETC structure (Exception from HRESULT: 0x80040064 (DV_E_FORMATETC))
What am I doing wrong here?
rg.
Eric
You could use directly My.Computer.FileSystem.CopyFile.
Dim source As String = lvFotos.SelectedItems(0).Tag
Dim destination As String = My.Computer.FileSystem.SpecialDirectories.Desktop & from.Substring(from.LastIndexOf("\"))
My.Computer.FileSystem.CopyFile(source, destination)
Using the code from John Smith at Copying a File To The Clipboard:
Dim f() As String = {"C:\temp\Folder.jpg"}
Dim d As New DataObject(DataFormats.FileDrop, f)
Clipboard.SetDataObject(d, True)
(Tested as working in VS2013 on Windows 7 x64.)
Note that you have to pass an array of strings representing your filename(s), so you could allow the user to gather several items before pasting, if you wanted to.
The true in Clipboard.SetDataObject allows the data to remain on the clipboard when you exit the program, so if the user were to select a file and exit before pasting, they would not have lost their selection.
Found what I was doing wrong.
At first I had tried it with the name of the file in an array, but that gave the same error.
Now I have it like this:
Dim selectedfile(0) As String
selectedfile(0) = Me.lvFotos.SelectedItems(0).Tag
Dim dataobj As New DataObject
dataobj.SetData(DataFormats.FileDrop, True, selectedfile)
Clipboard.Clear()
Clipboard.SetDataObject(dataobj, True)
The difference is in the line with SETDATA.
By setting the second argument to TRUE in SetData and also in the SetDataObject, it started to work.

VB.net UploadFile

I am trying to send a file up to a server using VB.net. I have found many examples exclaiming it to be simple to do but none of the examples I have found have worked.
The current one I am trying is in the following code:
Dim WithEvents wc As New System.Net.WebClient()
Private Sub oWord_DocumentBeforeClose(ByVal Doc As Microsoft.Office.Interop.Word.Document, ByRef Cancel As Boolean) Handles oWord.DocumentBeforeClose
Try
Using wc As New System.Net.WebClient()
wc.Credentials = New NetworkCredential("ehavermale", "ernie1")
wc.UploadFile("http://192.168.95.1:83/GraphTest.txt", "C:\Users\EHovermale\Desktop\GraphTest.txt")
End Using
Catch ex As Exception
MsgBox("Error:" + ex.Message)
End Try
'System.IO.File.Delete("C:\Users\EHovermale\Desktop\GraphTest.txt")
MsgBox("See Ya")
End Sub
When I run this program I get the Error: An Exception has occurred during a WebClient Request.
I have access to read/write files to the server I am trying to hit.
Is there another way to upload files or is something wrong with my code for this way?
Thank you!
Since there is no HTTP service to handle the file upload, you could save the file directly using VBA's Scripting.FileSystemObject. This will work if you can access the network share from wherever your document is located. Remember that if the document is moved to another computer then this may not work.
Public Sub MoveFile()
Dim fso As Object
Dim sourceFile As String
Dim targetFile As String
' You must add reference to "Microsoft Scripting Runtime" to your document
' Tools > References... > scroll down the item.
Set fso = CreateObject("Scripting.FileSystemObject")
sourceFile = "C:\Users\davidr\Desktop\foo.txt"
targetFile = "\\192.168.95.1:83\foo.txt"
' Test if destination file already exists
If fso.FileExists(targetFile) Then
MsgBox ("This file exists!")
Exit Sub
End If
' Move the file
fso.CopyFile sourceFile, targetFile
Set fso = Nothing
End Sub

Using Spire.PDF to merge pdf files Errors

I am using the free licenced version of Spire PDF. My program has in the region of 166,ooo pdf files which represent individual pages. I need to merge between 1 and 20 of these with the same names into one pdf.
I have a routine the builds a string of filenames to be added to an array which is passed to the following sub as PDFFiles. The OutputFile is the string with the name of the output file with it's path.
Private Sub MergePDFs(ByVal PDFFiles As String, ByVal OutPutFile As String)
Dim files As [String]() = New [String]() {"E:\Ballads of the 20th Century\1st bari #1.pdf", "E:\Ballads of the 20th Century\1st bari #2.pdf"}
Dim i As Integer
'open pdf documents
Dim docs As PdfDocument() = New PdfDocument(files.Length - 1) {}
For i = 0 To files.Length - 1
docs(i) = New PdfDocument(files(i))
Next
'append document
docs(0).AppendPage(docs(1))
'import PDF pages
i = 0
While i < docs(2).Pages.Count
docs(0).InsertPage(docs(2), i)
i = i + 2
End While
End Sub
I have the Solution Explorer I have the Spire.Pdf.dll as a file. In References I have Spire.Pdf and Spire.Licence.
At runtime I get An unhandled exception of type 'System.ArgumentException' occurred in Spire.Pdf.dll
Additional information: File doesn't exist.
The PDFFiles is not used in this example for clarity. The two files listed are taken directly from the program output for testing purposes.
There has to be a simple explanation for this error, but I haven't found one yet.
Please can you help solve it.
Thanks
Graham
I found the answer to this myself.
The actual problem was the way Spire.pdf parses a string into a pdf document.
There must be no spaces in the filename, then it works fine.
Graham