macro executed when document is loaded - libreoffice

After losing files from a HD, data rescue gave me back most of them, but with abstract names (such as file000123.xlsx). I need to rename them using cell values (client name, invoice ref).
I could make a Basic macro that works for this, if I open the files and start the macro myself for each one of those files.
As I have thousands of files to rename, I need that macro to execute on its own, either when documents are loaded, otherwise on a selected folder.
I assigned my macro to the "document loaded" event via the "tools-Customize-Events" menu. Then, I get a "wrong property value" error on the 1st line, the one defining the function.
Is my way of doing wrong ? Do I have to modify the macro for it to work there ?
Context :
This macro is in "My macros", not within the documents.
using libreOffice 7 on Linux
working on .xlsx files
Thanks for any help, my libreOffice Basic is even poorer than my English.. B-)
My code :
function getFullRep(sPath As String) As String
Dim cpt As Integer
Dim buf As String
Const SLASH = "/"
buf = ""
for cpt = Len(sPath) to 1 step -1
if Mid(sPath, cpt, 1) = SLASH then
buf = Left(sPath, cpt)
exit for
end if
next
getFullRep = buf
end function
Sub Main
Dim oDoc as Object
Dim sG2 as String
Dim sO2 as String
Dim sO as String
Dim sPathBackupFolder as String
Dim filespec As string
Dim laDate As String
Dim myfilename As String
Dim oFeuille As Object
Dim sNomFeuille As String
oDoc = ThisComponent
sPathBackupFolder = getFullRep (oDoc.location)
oFeuille = oDoc.getCurrentController().getActiveSheet()
sNomFeuille = oFeuille.getName()
laDate = Format(Now(),"YYMMDDhhmmss")
If oFeuille.GetCellRangeByName("G14").String <>"" Then
sG2 = oFeuille.GetCellRangeByName("G14").String
sO2 = oFeuille.GetCellRangeByName("A15").String
else
sG2 = oFeuille.GetCellRangeByName("G15").String
sO2 = oFeuille.GetCellRangeByName("A16").String
End If
sO = Replace(sO2, "Facture N°", "")
'Chemin et nom de fichier composé
myfilename = sPathBackupFolder+sG2+" - "+sO+" - "+laDate+".ods"
'Enregistrer sous
dim document as object
dim dispatcher as object
' ----------------------------------------------------------------------
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = ConvertToUrl(myfilename) 'On converti le chemin
args1(1).Name = "FilterName"
args1(1).Value = "calc8"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
oDoc.store
oDoc.close(True)
End Sub

You are getting the error because the document has not completely opened yet. Instead, attach to the event "View Created", and make sure to save to "LibreOffice" (as opposed to individual document).
By the way, it would be a good idea to give your sub a more appropriate name than "Main".
Hope that helps!

Related

Saving Email Attachments in Specified Folder, File Disappears

So I'm trying to make something that takes emails from a specific folder, and saves the attachments in a specific folder. I've taken this code from a previous post and retooled it for my purposes. It runs without error, but it isn't saving the file in the specified folder, and I can't for the life of me figure it out. Can anyone see my errors?
Sub ExtractFirstUnreadEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, Br As Object
Dim oOlAtch As Object
Dim eSender As String, dtRecvd As String, dtSent As String
Dim sSubj As String, sMsg As String
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
eSender = oOlItm.SenderEmailAddress
dtRecvd = oOlItm.ReceivedTime
dtSent = oOlItm.CreationTime
sSubj = oOlItm.Subject
sMsg = oOlItm.Body
Exit For
Next
Const AttachmentPath As String = "C:\Desktop\Test"
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
'NewFileName = oOlItm.Subject & Format(Date, "DD-MM-YYYY") & "-"
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
For Each oOlAtch In oOlItm.Attachments
Subject = "Test"
NewFileName = Subject
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Next
Exit For
Next
End Sub
I'd be so appreciative if anyone can point anything out. Thanks!
Picking a path at random is the road to failure.
The file should be saved in a folder named Test you created in C:\Desktop
Option Explicit
Sub ExtractFirstUnreadEmailDetails()
' Set up for Outlook
' not for other applications to use Outlook VBA code
Dim oOlInb As Folder
Dim Br As Folder
Dim oOlItm As Object
Dim oOlAtch As attachment
Dim Subject As String
'~~> Get Inbox of Outlook
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")
Const AttachmentPath As String = "C:\Desktop\Test"
'~~> New File Name for the attachment
Dim NewFileName As String
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
For Each oOlAtch In oOlItm.Attachments
Subject = "Test"
' Note the often forgotten path separator
NewFileName = AttachmentPath & "\" & Subject & Format(Date, "DD-MM-YYYY") & "-" & oOlAtch.fileName
' C:\Desktop\Test\Test17-07-2018-fileName
Debug.Print NewFileName
oOlAtch.SaveAsFile NewFileName
Next
Exit For
Next
End Sub
The result should be a file named: Test17-07-2018-Filename in the folder C:\Desktop\Test

Lotusscripts Get rich text field and send Email

I try to coding is sending Rich text field via email , but I find an error that's I think this method for sending email, by following code
Sub Click(Source As Button)
Dim s As New NotesSession
Dim w As New NotesUIWorkspace
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim uidoc As NotesUIDocument
Set uidoc = w.CurrentDocument
Set s = New NotesSession
Set w = New NotesUIWorkspace
Set db = s.CurrentDatabase
Set doc = New NotesDocument (db)
doc.sendTo =s.UserName
doc.Subject = "Employee Information"
Dim rt As NotesRichTextItem
Set rt = New NotesRichTextItem ( doc, "Body" )
'Dim file As Variant 'if I use this code for declare for get value; Error : Type Mismatch
'Set file = doc.GetFirstItem("Body")
Dim rtitem As NotesRichTextItem 'if I use this code for declare for get value ; Error : Missing text object
Set rtitem = doc.GetFirstItem( "Body" )
Call rt.AppendRTItem(rtitem)
doc.Send(False)
End Sub
One thing I notice is that you don't set the form on the mail document you are creating.
You have some code you don't need, since you don't use uidoc anywhere, no need for that or declaring a NotesUIWorkspace object.
I also recommend that you use better variable names, and not to use extended notation when you set field values in a NotesDocument object.
I suggest that you take a look at the articles here:
http://blog.texasswede.com/how-to-write-better-code-in-notesdomino/
Below is the code that I cleaned up:
Option Public
Option Declare
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim mailDoc As NotesDocument
Dim mailBody As NotesRichTextItem
Set db = session.CurrentDatabase
Set mailDoc = New NotesDocument(db)
Call mailDoc.ReplaceItemValue("Form","Memo")
Call mailDoc.ReplaceItemValue("SendTo",session.UserName)
Call mailDoc.ReplaceItemValue("Subject","Employee Information")
Set mailBody = New NotesRichTextItem(mailDoc,"Body" )
'Dim file As Variant 'if I use this code for declare for get value; Error : Type Mismatch
'Set file = doc.GetFirstItem("Body")
Dim rtitem As NotesRichTextItem 'if I use this code for declare for get value ; Error : Missing text object
Set rtitem = doc.GetFirstItem("Body")
Call mailBody.AppendRTItem(rtitem)
Call mailDoc.Send(False)
End Sub
The big question here is where you are getting the rich text field you want to send from? In your original code you are trying to read it from the newly created document (the one I call mailDoc). But that does not make any sense.
Your problem is simply that you are not reading the rich text from anywhere.
If your goal is to send an email, you can use my mail notification class:
http://blog.texasswede.com/updated-mailnotification-class-now-with-html-email-support-and-web-links/
Then your code would look something like this:
Dim session As New NotesSession
Dim mail As NotesMail
' *** Create a mail
Set mail = New NotesMail()
' Set receipient and subject
mail.MailTo = session.CommonUsername
mail.Subject = "Employee Information"
mail.Principal = "noreply#example.com"
' Create body content from rtitem.
' Yes, I should have added a method in the
' class to append RichtText to the mail body...
mail.body.AppendRTItem(rtitem)
Call mail.Send()
The only thing you have to do is to get the rtitem from somewhere. Since your original code declared a NotesUIWorkSpace object and a NotesUIDocument object, I am guessing you want to read it from the currently open document. Then you just add the following to the beginning of the code:
Dim ws As New NotesUIWorkspace
Dim thisdoc As NotesDocument
Dim rtitem as NotesRichTextItem
Set thisdoc = ws.CurrentDocument.Document
Set rtitem = thisdoc.GetFirstItem("Body")
Do you also see how much easier it is to read when you use descriptive variable names?
Hi you did not saved the document. Please be aware the Richtext is not available if the document is not saved.

Programmatically created form with name conflict

I'm creating in Excel VBA a form using code. The following code snippet presents a problem in which the form is somehow created with the name already correctly set and then afterwards, in the only place where I set the said variable, it raises an issue saying that there is a form with that name (the variable in case).
Here is my code:
Dim frmName As String
frmName = "frm_" & Replace(CStr(Nome_do_formulario), " ", "")
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
With myForm
.Properties("Caption") = Nome_do_formulario
.Properties("Width") = 300
.Properties("Height") = 270
.Properties("Name") = frmName
End With
To be clear, the error is that when it reaches the line:
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
Somehow it already creates a form with name that's set after at the with statement:
With myForm
.Properties("Caption") = Nome_do_formulario
.Properties("Width") = 300
.Properties("Height") = 270
.Properties("Name") = frmName '<- HERE
End With
And then, when it tries to run the with statement it breaks and says that a form with that name already exists.
The whole thing is ran at another module as:
Public Sub Main()
Dim ac As autoCrud
Set ac = New autoCrud
ac.CreateCRUDView
End Sub
The form creation happens inside the ac.CreateCRUDView.
How is it pulling the name variable before it's set and then trying to use it to make another form with the same name?
VBE suffers heavily corruption when it is about UserForms collection in a VBA Project.
Even if you remove explicitly a UserForm from your project, you might get errors creating programatically (and sometimes in the normal way) another with the same name.
Try using this approach:
Dim frmName As String
Dim myForm As VBComponent
frmName = "frm_" & Replace(CStr(Nome_do_formulario), " ", "")
ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name = frmName
Set myForm = ThisWorkbook.VBProject.VBComponents(frmName)
With myForm
.Properties("Caption") = Nome_do_formulario
.Properties("Width") = 300
.Properties("Height") = 270
End With
Remember, if you delete the newly created userform and run this code with the same Nome_do_formulário value, you'll get an error.

sending outlook based email in VBScript - error (sfile as string) line?

im trying to send an email from a VBScript, it will eventually be added into a currently working script as an else if (if this is possible).
im getting an error at line 23 character 32?
Dim outobj, mailobj
Dim strFileText
Dim objFileToRead
Set outobj = CreateObject("Outlook.Application")
Set mailobj = outobj.CreateItem(0)
strFileText = GetText("C:\test\test 2.txt")
With mailobj
.To = "user#user.com"
.Subject = "Testmail"
.Body = strFileText
.Display
End With
Set outobj = Nothing
Set mailobj = Nothing
End Sub
Function GetText(sFile as String) As String
Dim nSourceFile As Integer, sText As String
nSourceFile = FreeFile
Open sFile For Input As #nSourceFile
sText = Input$(LOF(1), 1)
Close
GetText = sText
End Function
what do i need to add to get line 23 to work and the script to finally do what i need it to, i have copied most of this script from elsewhere due to a sincere lack of VBscripting knowledge?
Take a look at the Using Automation to Send a Microsoft Outlook Message article. It provides a sample code and describes all the required steps for sending emails.
Try this: remove the GetText function entirely, and replace the line
strFileText = GetText("C:\test\test 2.txt")
with
Set fso = CreateObject("Scripting.FileSystemObject")
strFileText = fso.OpenTextFile("C:\test\test 2.txt").ReadAll

Access VBA Classes Arrays

Im trying to use some classes that will hold invoice data and I cant seem to get it working. I just want it to save details of an invoice in an array. Heres the code, maybe someone can figure it out.
Also id like for the LineItems to take a random number of product items, not sure how to do that yet. Im doing this to eventually send the data through a web service from ms access.
Here is the other code for struct_XOrder:
Public OrderNumber As String
Public ClientShortName As String
'"LineItems" is an array with elements defined as struct_LineItem
'See Complex Types: Arrays in Microsoft Office 2003 Web Services Toolkit Help
'for details on implementing arrays.
Public LineItems As Variant
Public OrderError As String
Heres the struct_LineItem:
Public ProductSKU As String
Public Qty As Long
Public UnitPrice As Variant
Public ItemComment As String
Public ItemError As String
Heres my main code
Sub webservicetest()
Dim NewOrder As struct_XOrder
Dim LineItems(1 To 2) As Variant
Dim Xline(1 To 2) As Variant
Set Xline() = struct_LineItem
Set NewOrder = New struct_XOrder
Set NewOrder.LineItems() = New struct_LineItem
Set NewOrder.LineItems() = New Xline
'Xline = New struct_LineItem
Xline(1).ItemComment = "items"
Xline(1).Qty = 10
NewOrder.LineItems() = Xline()
NewOrder.ClientShortName = "DemoClient"
NewOrder.OrderNumber = "12345"
'Xline(1).ItemComment = "item1"
'Xline(1).Qty = 5
Debug.Print NewOrder.ClientShortName
Debug.Print NewOrder.OrderNumber
'For i = LBound(Xline) To UBound(Xline): Debug.Print Xline(i): Next
'Debug.Print Xline(1).ItemComment
'Debug.Print Xline(1).Qty
End Sub
See comments for explanations.
Use Type instead within VBA to create structs. Also, you do not need to use Set the way you are.
Additionally, use Option Explicit to require variable declarations whenever using VBA unless you want a nightmare.
This all can go in the same module.
'use this
Option Explicit
'VBA structs are defined like the following
'and do not need "new" (similar to other languages)
'when creating them
Type struct_LineItem
ProductSKU As String
Qty As Long
UnitPrice As Variant
ItemComment As String
ItemError As String
End Type
Type struct_XOrder
OrderNumber As String
ClientShortName As String
'make this more clear
LineItems() As struct_LineItem
OrderError As String
End Type
Sub webservicetest()
Dim NewOrder As struct_XOrder
Dim LineItems(1 To 2) As Variant
Dim Xline(1 To 2) As struct_LineItem
'you can't do this, you need to specify which element
'in XLine you want to set
'Set Xline() = struct_LineItem
Dim myStruct As struct_LineItem
Xline(1) = myStruct
'you don't need "set"
NewOrder.LineItems = Xline()
'this won't update as if it's a reference, btw
Xline(1).ItemComment = "items"
Xline(1).Qty = 10
NewOrder.LineItems = Xline()
NewOrder.ClientShortName = "DemoClient"
NewOrder.OrderNumber = "12345"
Debug.Print NewOrder.ClientShortName
Debug.Print NewOrder.OrderNumber
'don't do ":" as this makes code unbearably not readable...
'For i = LBound(Xline) To UBound(Xline): Debug.Print Xline(i): Next
Dim i As Integer
For i = 1 To UBound(NewOrder.LineItems)
Debug.Print NewOrder.LineItems(i).ItemComment
Next i
End Sub