[Solved] Can't execute macro from Base

[AfTech54]

Hi!
I can't execute macros from my base form button. The macro is working if I run it directly from Tools>Macros>Organize macros>OpenOffice basic-macros>My Macros>Standard>Base>Existing macros>selected macro>run

In OOO>Settings>Tools>Security>Macro Security:
I've set level to High or Highest and selected Trusted sources:
C:\Users\Roger\AppData\Roaming\OpenOffice\4\user\basic\standard (where I can find my macros).

The button is still not executing the macro!
The AppData folder is hidden if that matters?

[Zizi64]

Try to set the Macro security to Medium. (At least set it temporarly.) Then the LO will ask you at opening the file about the macro running. You can enable or disable it.

Which event of the Button you have assigned the macro to?

The AppData folder is hidden if that matters?

It is hidden on Windows by default. You can set them "visible" in the two panel file manager softwares like the Total Commander.

[AfTech54]

Tanks Zizi64!

I doesn't work with medium either.

I'm using Mouse Button Pressed/Clicked.
One button open a help-dialog and the other creates a csv-file by first opening a dialog so I can enter a filename to it.
I don't think the problem is with the macros as I can run them directly from the tools menu.

[Zizi64]

Can you upload the macro code here? (And please upload a sample file if it is possible...)

[AfTech54]

Couldn't upload the macros here so I sent it to you by mail.

[Hagar Delest]

If the macros are too long, you can attach them in a txt file for example.

[Zizi64]

I just tried to embed the macro code received by email, but the unwanted LineFeeds in the email messed up the structure of the the code. I fixed some lines but there are too many lines...

Test DB.odb

(22.97 KiB) Downloaded 335 times

[Zizi64]

Here is the received code (Copy-Pasted from the email):

Code: Select all

REM  *****  BASIC  *****

Sub Main

End Sub

Sub Export_Into_Csv

        ExportHSQL

End Sub



REM  *****  BASIC
REM
**********************************************************************************************
REM
https://forum.openoffice.org/en/forum/viewtopic.php?f=13&t=26843&p=122081&hilit=SYSTEM_TABLES#p122081
REM  *****  Macro to Create a txt file Output From Query in Base HSQL
REM  *****  Originally written by Sliderule 2009-07-25
REM  *****  Will take an existing Query / Table in the given database, ADD
code "INTO TEXT " + sOutputFileName
REM  *****  So an .txt ( or .CSV based on commented code below ) will be
created
REM  *****  in the same directory where your *.odb file exists
REM  *****
REM  *****  ALTER / CHANGE sQuery_Default to reflect the default name of
the Query / Table / View  to be output
REM  *****  ALTER / CHANGE sOutputFileName_Default to reflect your default
Output CSV file to be created
REM  *****  ALTER / CHANGE sHeader_Default to reflect your default to
include "header" ( field names ) as first row
REM  *****  ALTER / CHANGE sDBName_Default to reflect your default
REGISTERED Database File Name
REM  *****
REM  ***** If, First Parameter ( sQuery ) is AllTables . . . will
automatically create txt file for all Tables in HSQL database
REM  *****
REM  ***** To run from Calc, use the following as examples:
REM  ***** =ExportHSQL() -- Run the Function with all the DEFAULT
parameters
REM  ***** =ExportHSQL("?")  -- To display a HELP screen explaining the
function parameters
REM  ***** =ExportHSQL("Prompt") -- To Prompt User for each of the 4
Parameter Input via InputBox Prompts
REM  ***** =ExportHSQL("MyQuery")  -- Run with designated Query, default
output file, Headers and DB Name
REM  ***** =ExportHSQL("MyQuery";"MyOutput_txt") -- Run with given Query,
given Output File Name, default Headers and DB Name
REM  ***** =ExportHSQL("MyQuery";;;"MyDBName") -- Run with given Query,
default Output File Name, default Headers, given DB Name
REM  ***** =ExportHSQL("AllTables")  -- For all tables in DB, default
output file, default Headers and DB Name
REM  ***** =ExportHSQL("AllTables";;"Headers-No")  -- For all tables in DB,
default output file, Headers No and default DB Name
REM  ***** =ExportHSQL("AllTables";;"Headers-No";"MyDBName")  -- For all
tables in DB, default output file, Headers No and given DB Name
REM  ***** =ExportHSQL("AllTables";;"Headers-Yes";"MyDBName")  -- For all
tables in DB, default output file, Headers Yes and given DB Name
REM  *****
REM
**********************************************************************************************

Function ExportHSQL(Optional sQuery as String, Optional sOutputFileName, _
                            Optional sHeader as String, Optional sDBName as
String)

REM XXXXXXXXXXXXXXXX MODIFIERING XXXXXXXXXXXXXXXXXXXXXXXXX
        sYourFileName = InputBox(Chr$(13) + "Ange ett namn på csv-filen")
        Dim sHH as String
        Dim sMI as String
        Dim sSS as String
        sHH = Hour(Now())
        If Len(sHH) = 1 then sHH = "0" + sHH
        sMI = Minute(Now())
        If Len(sMi) = 1 then sMI = "0" + sMI
        sSS = Second(Now())
        If Len(sSS) = 1 then sSS = "0" + sSS                               

 ' * * W A R N I N G -- the Query/Table name given here, and, passed, MUST
match CASE ( UPPER/lower/Mixed ) as defined in database
   sQuery_Default = "CatSearch_to_Csv"  '<< name of Query/Table to run
(withOUT "INTO TEXT ... " information) when not entered
REM XXXXXXXXXXXXXXXX MODIFIERING
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
REM ORIGINAL XXXX sOutputFileName = sQuery + "_" + CDateToIso(Date) +
"_txt"
   sOutputFileName_Default = "CatSearch_" + sYourFileName + "_" + sHH + sMI
+ sSS + "_CSV"   '<<< Make Default from sQuery_Default + '_' + Date +
'_txt'
   sHeader_Default = "Header-No"     '<< when "Header-Yes" include as first
row "header" ( field names ), Else only data
   sDBName_Default = "Foto- och filmkatalog"   '<< registered datasource .
. . Change for YOUR DB name

   sFunctionName = "ExportHSQL"  '<< Name of this running function for use
in MSGBOX

   Dim sErrorMsg, sDrop_CSV_SQL As String
   Dim sQuote As String    '<< character defined by database for a quote
   Dim sPath As String     '<< Directory path to location of .ODB file --
determined by Macro
   Dim sPath2 As String    '<< Directory path to location of HSQL JDBC data
file if needed
   Dim sJDBC As String     '<< Will be "Yes" if using HSQL as a Server (
JDBC ), "No" when Embedded database
   Dim oStatement, oDBSource, oConnection, oDatabaseContext, oQueries,
oResultSet As Object

   ' When an SQL error - for instance, not unique values, tell user here
   On Error GoTo SQLErrorHandler

   'Default sQuery if not entered as a passed parameter
   If LEN(sQuery) = 0 OR LCASE(LEFT(sQuery,5)) = "error" OR sQuery = "0"
Then
      sQuery = sQuery_Default
   End If

   'Default sOutputFileName if not entered as a passed parameter
   If LEN(sOutputFileName) = 0 OR LCASE(LEFT(sOutputFileName,5)) = "error"
OR sOutputFileName = 0 Then
      sOutputFileName = sOutputFileName_Default
REM XXXXXXXXXXXXXXXX MODIFIERING
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
REM ORIGINAL XXXX sOutputFileName = sQuery + "_" + CDateToIso(Date) +
"_txt"
      sOutputFileName = "CatSearch_" + sYourFileName + "_" + sHH + sMI +
sSS + "_CSV"   '<<< Make Default from sQuery_Default + '_' + Date + '_txt'
   End If

   'Default sHeader if not entered as a passed parameter -- headers is
first row field names, if not "Header-Yes" data only
   If LEN(sHeader) = 0 OR LCASE(LEFT(sHeader,5)) = "error" OR sHeader = "0"
Then
      sHeader = sHeader_Default
   End If

   sHeader = TRIM(sHeader)   '<<Trim to remove any leading or trailing
spaces, to ensure value compares successfully

   If UCASE(sHeader) = "HEADER-YES" OR UCASE(sHeader) = "HEADERS-YES" Then
      sHeader = "Header-Yes"
   End If

   'Default sDBName if not entered . . . note . . . HSQL system tables need
a DB name of information_schema
   'This name is the 'Database Registered Name'
   If LEN(sDBName) = 0 OR LCASE(LEFT(sDBName,5)) = "error" OR sDBName = "0"
Then
      sDBName = sDBName_Default
   End If

   ' = = = = = = = = = = = = = = = = =
   'Check if user entered "?" or "help" as first parameter ( from Calc ) .
. . if so . . . display Help Screen
   If TRIM(sQuery) = "?" OR UCASE(TRIM(sQuery)) = "HELP" Then
      MsgBox (sFunctionName + " Function   " + Chr$(13) + Chr$(13) + _
             + Chr$(13) + Chr$(13) + _
             "=" + sFunctionName + "( ""Query / Table Name"";
""OutputFileName""; " + _
             """Header""; ""DBName"" )" + _
             + Chr$(13) + Chr$(13) + _
             + "Macro / User Defined Default  " + sFunctionName + "  Values
are:" + _
             + Chr$(13) + Chr$(13) + _
             + "=" + sFunctionName + "( " + Chr$(34) + sQuery_Default +
Chr$(34) + "; " + _
             + Chr$(34) + sOutputFileName_Default + Chr$(34) + "; " + _
             + Chr$(34) + sHeader_Default + Chr$(34) + "; " + _
             + Chr$(34) + sDBName_Default + Chr$(34) + " )" + _
             + Chr$(13) + Chr$(13) + _
             "Up to 4 Parameters:" + _
             + Chr$(13) + Chr$(13) + "1. Query Name or Table Name" + _
             + Chr$(13) + "2. Output File Name" + _
             + Chr$(13) + "3. Include First Row Field Names IF =
""Header-Yes""" + _
             + Chr$(13) + "4. Registered Database Name" + _
             + Chr$(13) + Chr$(13) + _
             "To Present User with Prompts for 4 Inputs:" + _
             + Chr$(13) + Chr$(13) + "=" + sFunctionName + "(""Prompt"")" +
_
             + Chr$(13) + Chr$(13), + _
             64,"Help: " + sFunctionName)
      Exit Function
   End If
   ' = = = = = = = = = = = = = = = = =

   ' = = = = = = = = = = = = = = = = =
   ' Check if user entered "Prompt" as first parameter ( from Calc ) . . .
if so . . . Prompt User for each of the 4 Parameters
   If TRIM(UCase(sQuery)) = "PROMPT" Then

      'Since the word "Prompt" can be defined as sQuery_Default
      'and, do NOT want that value as 'default' when asking for output
name, change the diplsay to no name just in case
      If UCASE(sQuery_Default) = "PROMPT" Then
         sPromptQueryName = ""
      Else
         sPromptQueryName = sQuery_Default
      End If


      'Ask user for Value of sQuery
      sQuery = InputBox(Chr$(13) + "Enter the Query name   OR  Table name
for output as .txt file" _
                         + Chr$(13) + Chr$(13), "Enter Name of Query /
Table to output", sPromptQueryName)

      If LEN(sQuery) = 0 Then  '<< Since Cancel choosen, we will end the
function
         Exit Function
      End If

      sQuery = TRIM(sQuery)   '<<Get rid of leading or trailing spaces

      'Ask user for Value of sOutputFileName
      sOutputFileName = InputBox(Chr$(13) + "Enter the Output File Name -
.txt wll be added" _
                         + Chr$(13) + Chr$(13), "Enter Output File Name",
sQuery + "_" + CDateToIso(Date) + "_txt" )
'                         + Chr$(13) + Chr$(13), "Enter Output File Name",
sOutputFileName_Default)

      If LEN(sOutputFileName) = 0 Then  '<< Since Cancel choosen, we will
end the function
         Exit Function
      End If

      sOutputFileName = TRIM(sOutputFileName)   '<<Get rid of leading or
trailing spaces

      'Ask user for Value of sHeader
      sHeader = InputBox(Chr$(13) + " Header-Yes  =  include Field name as
first line of output" _
                         + Chr$(13) + Chr$(13) + "Header-No   =  output
only data" _
                         + Chr$(13) + Chr$(13), "Include Field Names  OR
Data Only ? ? ?", sHeader_Default)

      If LEN(sHeader) = 0 Then  '<< Since Cancel choosen, we will end the
function
         Exit Function
      End If

      sHeader = TRIM(sHeader)   '<<Get rid of leading or trailing spaces

      If UCASE(sHeader) = "HEADER-YES" OR UCASE(sHeader) = "HEADERS-YES"
Then
         sHeader = "Header-Yes"
      End If

      'Ask user for Value of sDBName
      sDBName = InputBox(Chr$(13) + "Enter Name of the Registered Database
File" _
                         + Chr$(13) + Chr$(13), "Enter Registered Database
Name", sDBName_Default)

      If LEN(sDBName) = 0 Then  '<< Since Cancel choosen, we will end the
function
         Exit Function
      End If

      sDBName = TRIM(sDBName)   '<<Get rid of leading or trailing spaces

   End If
   ' = = = = = = = = = = = = = = = = =

   oDatabaseContext = createUnoService( "com.sun.star.sdb.DatabaseContext"
)

   If oDatabaseContext.hasByName(sDBName) Then
      'We have found the registered datasource so can continue processing
   Else
      'Since no such Registered database, inform user including a list of
valid Registered database names
      sErrorMsg = "Macro: " + sFunctionName + "                        " &_
             + Chr$(13) + Chr$(13) + "No Registered Database found by name:
  " + Chr$(13) + Chr$(13) + sDBName _
             + Chr$(13) + Chr$(13) + "Registered Database names are CASE (
UPPER / Mixed / lower ) sensitive." _
             + Chr$(13) + Chr$(13) + Chr$(13) + "Valid Registered DB Names
Include:" + Chr$(13) + Chr$(13)

      sValidRegisteredDBNames = oDatabaseContext.getElementNames()

      '<<< Display the Valid DB Registered Names
      For i = LBound(sValidRegisteredDBNames) To
UBound(sValidRegisteredDBNames)
         sErrorMsg = sErrorMsg + sValidRegisteredDBNames(i) + Chr$(13)
      Next i

      BEEP
      msgbox (sErrorMsg, 16, "Correct Registered Database Name")

      Exit Function   ' End the Macro somce no valid registered datasource
( DB ) name entered
   End If

   oDBSource = oDatabaseContext.GetByName(sDBName)

   oConnection = oDBSource.GetConnection("SA", "")   
   sResultVersionString =
oConnection.getMetaData().getDatabaseProductVersion()   '<<< This is the
HSQL Version
   sResultDatabaseNameString =
oConnection.getMetaData().getDatabaseProductName() '<<< This is the
Database product Name
   oStatement = oConnection.createStatement()

   '<< Table/Column identifier for this database
   sDBDelimiter = oConnection.getMetaData().getIdentifierQuoteString()

   'Make Sure will NOT delete a valid Table / View name - so, if already
exists, give warning and end Macro
   If Instr(sResultDatabaseNameString,"HSQL") Then
      ' Since this is an HSQL engine, everything is fine, continue
   Else
      msgbox ("Macro: " + sFunctionName + "                        " &_
              + Chr$(13) + Chr$(13) + sResultDatabaseNameString + " is NOT
an HSQL Database Engine " &_
              + Chr$(13) + Chr$(13) + "Therefore will NOT proceed with this
macro!" &_
              + Chr$(13) + Chr$(13) + "This Macro is only for HSQL Database
Engine!" &_
              + Chr$(13) + Chr$(13) , 16, "Error Ending Macro")
      Exit Function  ' End the Macro since no table / view already exists
by that name
   End If


   'Make Sure will NOT delete a valid Table / View name - so, if already
exists, give warning and end Macro
   If oConnection.Tables.hasByName( sOutputFileName) Then
      msgbox ("Macro: " + sFunctionName + "                        " &_
              + Chr$(13) + Chr$(13) + "sOutputFileName must not be same as
existing Databae " &_
              + Chr$(13) + "File or View Name" &_
              + Chr$(13) + Chr$(13) + "sOutputFileName = " &_
              + sOutputFileName+ Chr$(13) + Chr$(13), 16, "Error Ending
Macro")
      Exit Function  ' End the Macro since no table / view already exists
by that name
   End If

   sQuote = oConnection.getMetaData().getIdentifierQuoteString()   '<<
Quote identifier for this database

   oPathSettings = CreateUnoService( "com.sun.star.util.PathSettings" )
   sPath = oPathSettings.Work_Writable() + "/"   '<< Return the complete
directory name for location of .ODB file

   ' Delete any perviously existing output file name . . . since . . . do
NOT want to append data to it
   If FileExists(sPath + sOutputFileName + ".txt") THEN
      Kill sPath + sOutputFileName + ".txt"
   End If

   If FileExists(sPath + sOutputFilename + ".CSV") THEN
      Kill sPath + sOutputFileName + ".CSV"
   End If


   'If the sQuery is 'AllTables', user wants to process output for ALL
TABLES, therefore, use function ExportAllTables
   If UCASE(TRIM(sQuery)) = "ALLTABLES" Then
      ExportAllTables(sHeader,sDBName)
      Exit Function   'End the processing
   End If

   oQueries = oDBSource.QueryDefinitions   '<<queries in datasource
   oTables  = oDBSource.Tables             '<<tables in datasource

   'Confirm entered sQuery is either a Query name, OR, a Table name
   If ( oQueries.hasByName( sQuery) )  OR ( oConnection.Tables.hasByName(
sQuery) ) Then
       'When a Query Name get the SQL
       If ( oQueries.hasByName( sQuery) ) Then
               oQuery = oQueries.getByName( sQuery )   '<< the query in
question
               sQuery = oQuery.Command '<< content of query
       Else
          'Since a Table name, write the SQL - if MySQL (separated by a
period [ . ] delimit sDBDelimiter
          sQuerySplit = SPLIT(sQuery,".",2)

          If InStr(1,sQuery,".") >= 1 Then   'If the Table Name has a
period, surround by sDBDelimiter
             sQuery = sDBDelimiter + sQuerySplit(0) + sDBDelimiter + "." _
                      + sDBDelimiter + sQuerySplit(1) + sDBDelimiter
          Else   'No Period in Table Name so delimit it with sDBDelimiter
             sQuery = sDBDelimiter + sQuery + sDBDelimiter
          End If

          '<<< Since a Table entered -- have to create the SQL to run table
name
          sQuery = "SELECT * From " + sQuery
       End If               


   Else
      msgbox ("Macro: " + sFunctionName + "                        " &_
              + Chr$(13) + Chr$(13) + "sQuery must be the same as an
existing Query or Table " &_
              + Chr$(13) + "Including Match by CASE ( UPPER / lower / Mixed
)" &_
              + Chr$(13) + Chr$(13) + "sQuery = " &_
              + sQuery + Chr$(13) + Chr$(13), 16, "Error Ending Macro")
      Exit Function
   End If


   ' Added by Sliderule 2009-07-26 to allow for Parameter Queries
Substitution
   ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   'Verify Query is NOT a Paraemter Query ( with a prompt indicated by : )
   '- Allow user to RUN in case a Comment or String with colon
   InputParameterPrompt:

   'Any Saved Query with a Prompt will always have a space before : prompt
and after
   'Therefore, any time format ( HH:MM:SS ) etc not result in any errors
   If InStr(1,sQuery," :") >= 1 Then

      nParameterStart = InStr(1,sQuery," :")   'Position of SQL for start
of " :"
      sParameterPrompt = TRIM(MID(sQuery, nParameterStart + 1))   'Remove
text before " :"
      nParameterStart = InStr(1,sParameterPrompt," ")   'Position of
remaining SQL with " " character
      sParameterPrompt = MID(sParameterPrompt, 2, nParameterStart - 1) 
'Characters making up prompt

      'User is prompted to input necessary parameters with InputBox
Function
      sGetInput = Trim(InputBox ("Parameter Query Name: " +
sQueryNameAsEntered + _
                                  Chr$(13) + Chr$(13) + sParameterPrompt, +
_
                                  "Please Enter: " + sParameterPrompt) )

         If sGetInput = "" Then   'Cancel is Pressed above so end Run
            GoTo TheEnd
         End If

         IF IsDate(sGetInput) Then  'User Entered A Date so escape with
single quotes as YYYY-MM-DD
            'Since we have a legal date . . . and . . . it must be in
YYYY-MM-DD format for SQL
            'turn the legal date to an 8 character YYYYMMDD date and then
add - to format as YYYY-MM-DD
            sGetInput = MID(CDateToISO(sGetInput),1,4) & "-" &
MID(CDateToISO(sGetInput),5,2) _
                            & "-" & MID(CDateToISO(sGetInput),7,2)
            ' sQuery = ReplaceString_ExportHSQL(sQuery,":" + _
            ' sParameterPrompt,"'" + sGetInput + "'")
            'Need to Format Dates with {D 'YYYY-MM-DD'} Format ( brackets )
            sQuery = ReplaceString_ExportHSQL(sQuery,":" + _
                            sParameterPrompt,"{D '" + sGetInput + "'}")
         Else
            If IsNumeric(sGetInput) Then   'User Entered a Number so no
escape sequence needed
               sQuery = ReplaceString_ExportHSQL(sQuery,":" +
sParameterPrompt, sGetInput)
            Else   'User Entered Text so escape with single quotes
               sQuery = ReplaceString_ExportHSQL(sQuery, _
                         ":" + sParameterPrompt,"'" + sGetInput+"'")
            End If

         End If

        GoTo InputParameterPrompt   'Need this to see if more than one
prompt in Query

   EndIf

   ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

   'Changes Made 2009-10-13 To Determine HSQL Version
   '-- When 1.8 use INTO TEXT FileName
   '-- Otherwise series of commands to create text file and insert data

   ' 20100121    This SQL used to determine in oResultSet MetaData.URL
information
   sDetermine_HSQL_Version = "SELECT TOP 1 CURRENT_DATE FROM
""INFORMATION_SCHEMA"".""SYSTEM_TABLES"""
   oResultSet = oStatement.executeQuery( sDetermine_HSQL_Version )

   sResultVersionString = MID(sResultVersionString,1,3)   '<< First three
characters . . .

   'When using HSQL as a Server - Have to determine location ( directory )
of HSQL DB files
   If UCase(MID(oResultSet.Statement.Connection.MetaData.URL,1,4)) =
UCase("jdbc") Then
      sGetPathSQL = "SELECT REPLACE(VALUE,DATABASE(),'') as Path FROM
INFORMATION_SCHEMA.SYSTEM_SESSIONINFO WHERE KEY = 'DATABASE'"
      oResultSet = oStatement.executeQuery( sGetPathSQL )

      while oResultSet.next()
         sPath2 = oResultSet.getString(1)
      wEnd

      If LCASE(MID(sPath2,1,5)) = "file:" Then
         sPath2 = MID(sPath2,6)   '<<< Get rid of file:    if part of
sPath2
      End If

      'MsgBox("Macro: " & sFunctionName & Chr$(13) & Chr$(13) &
sPath2,64,"HSQL Data Directory") '<<< Display HSQL Data Directory

      '<<< This means using HSQL with JDBC driver NOT Embedded HSQL
database so output in HSQL data directory
      sJDBC = "Yes"

   Else
      '<<< This means using HSQL as Embedded Database - so output already
in same directory as .odb file
      sJDBC = "No"
   End If


   ' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = = =
   ' Proecess Field / Column Header as first line, ONLY when sHeader =
"Header-Yes" otherwise only output data
   If sHeader = "Header-Yes" Then

      oResultSet = oStatement.executeQuery( sQuery ) '<<  Execute the Query
to oResultSet to get Column Names

      'Write out the Column Names delimited by cSeparator as defined in SQL
above
      dim mData as object  'Contents of oResultSet so can determine
Names/Number of Columns returned

      mData = oResultSet.getMetaData()

      nColumns = mData.getColumnCount()   'This is the number of columns in
the Output set

      dim sNameColumns(nColumns) As String  'Get string Column Names . . .
After determining number needed

      If nColumns > 0 Then        'If we have any columns returned
         ReDim Preserve Result(1 to nRows + 1, 1 to nColumns)

         For n = 1 to nColumns
             sNameColumns(n) = mData.getColumnName(n)

             If n = nColumns Then     'Last Column so no trailing ","
                sColumnNamesDelimited = sColumnNamesDelimited +
sNameColumns(n)
             Else
                sColumnNamesDelimited = sColumnNamesDelimited +
sNameColumns(n) + ","
             End If

         Next n

      ' Print sColumnNamesDelimited

      End If

   End If
   ' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = = =

   If sResultVersionString = "1.8" Then
      sQuery = ReplaceString_ExportHSQL(sQuery, "FROM ", " INTO TEXT " +
sQuote + sOutputFileName + sQuote + " FROM ")

      ' msgbox (sQuery, 16, "ErrorHandler - sQuery")               '<<
Display created SQL if desired

      ' Now, if a TEXT TABLE file with the given name already exists, DROP
( delete ) it
      sDrop_CSV_SQL = "DROP TABLE " + sQuote + sOutputFileName + sQuote + "
IF EXISTS;"

      ' msgbox (sDrop_CSV_SQL, 16, "ErrorHandler - sDrop_CSV_SQL") '<<
Display created SQL if desired

      sSource_Off = "SET TABLE " + sQuote + sOutputFileName + sQuote + "
SOURCE OFF;"

      ' msgbox (sSource_Off, 16, "ErrorHandler - sSource_Off") '<<  Display
created SQL if desired

      oStatement.executeUpdate( sDrop_CSV_SQL )   '<<  Drop the TEXT TABLE
file from the database if it exists

      oStatement.executeQuery( sQuery )           '<<  Create the Text
Database File, and, .CSV File

      oStatement.executeUpdate ( sSource_Off )    '<<  Disconnect from data
source, .CSV

      oStatement.executeUpdate( sDrop_CSV_SQL )   '<<  Drop the TEXT TABLE
file from the database if it exists

   Else   '<< We are at least with HSQL 1.9 or later, so, do the following
steps

      ' Now, if a TEXT TABLE file with the given name already exists, DROP
( delete ) it
      sDrop_CSV_SQL = "DROP TABLE " + sQuote + sOutputFileName + sQuote + "
IF EXISTS;"

      'msgbox (sDrop_CSV_SQL, 16, "ErrorHandler - sDrop_CSV_SQL") '<<
Display created SQL if desired

      sSource_Off = "SET TABLE " + sQuote + sOutputFileName + sQuote + "
SOURCE OFF;"

      'msgbox (sSource_Off, 16, "ErrorHandler - sSource_Off") '<<  Display
created SQL if desired

      oStatement.executeUpdate( sDrop_CSV_SQL )   '<<  Drop the TEXT TABLE
file from the database if it exists

      sCreateTextTable = "CREATE TEXT TABLE " & sQuote & sOutputFileName &
sQuote & " AS ( " & sQuery & ") WITH NO DATA"

      'msgbox (sCreateTextTable, 16, "ErrorHandler - sCreateTextTable") '<<
 Display created SQL if desired

      oStatement.executeUpdate( sCreateTextTable )

      sSetSource = "SET TABLE " & sQuote & sOutputFileName & sQuote & "
SOURCE " & sQuote & sOutputFileName & ".txt" & sQuote

      oStatement.executeUpdate( sSetSource )

      sInsertTextTable = "INSERT INTO " & sQuote & sOutputFileName & sQuote
& " (" & sQuery & ")"

      'msgbox (sInsertTextTable, 16, "ErrorHandler - sInsertTextTable") '<<
 Display Insert Into Statement

      oStatement.executeUpdate( sInsertTextTable )

      oStatement.executeUpdate( sSource_Off )     '<< Disconnect from data
source, .CSV

      oStatement.executeUpdate( sDrop_CSV_SQL )   '<< Drop the TEXT TABLE
file from the database if it exists

   End If

   sPath = ConvertFromURL(sPath)   '<<< This will change file:/// to
'correct' Path notation

   ' Rename the output from a .csv file to .txt file
   If FileExists(sPath + sOutputFileName + ".csv") THEN
      Name sPath + sOutputFileName + ".csv" as sPath + sOutputFileName +
".txt"
   End If

   '= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = =
   'Only write the Headers to the sequential file when sHeader =
"Header-Yes", otherwise only data
   If sHeader = "Header-Yes" Then

      If FileExists(sPath + sOutputFileName + ".txt") OR FileExists(sPath2
+ sOutputFileName + ".txt") Then
         'Open (sPath + sOutputFileName + ".TXT") For Append As #FileOpen
         iTempOutputFile = FreeFile()

         If FileExists(sPath + sOutputFileName + ".txt2") Then   'Remove
any 'temporary' file if it exists
            Kill sPath + sOutputFileName + ".txt2"
         End If

         If sJDBC = "Yes" Then   '<<< HSQL as JDBC driver, so, output in
HSQL DATA directory
            Open (sPath2 + sOutputFileName + ".txt2") For Append As
iTempOutputFile
         Else   '<<< HSQL as Embedded OpenOffice datase, so, data output in
.odb directory
            Open (sPath + sOutputFileName + ".txt2") For Append As
iTempOutputFile
         End If

         Print #iTempOutputFile, sColumnNamesDelimited

         iOutputTXTFile = (iTempOutputFile + 1)

         'Open File for output depending on directory located in
         If sJDBC = "Yes" Then   '<<< HSQL as JDBC driver, so, output in
HSQL DATA directory
            Open (sPath2 + sOutputFileName + ".txt") For Input as
iOutputTXTFile
         Else   '<<< HSQL as Embedded OpenOffice datase, so, data output in
.odb directory
            Open (sPath  + sOutputFileName + ".txt") For Input As
iOutputTXTFile
         End If

         While not EOF(iOutputTXTFile)   'Read the file from the start til
the End of File

            Line Input #iOutputTXTFile, sLine
            Print #iTempOutputFile, sLine

         WEnd

         Close #iTempOutputFile
         Close #iOutputTXTFile

         'Remove File so can rename it to desired name
         If FileExists(sPath + sOutputFileName + ".txt") Then
            Kill sPath + sOutputFileName + ".txt"
         End If

         'Remove File so can rename it to desired name
         If sJDBC = "Yes" AND FileExists(sPath2 + sOutputFileName + ".txt")
Then
            Kill sPath2 + sOutputFileName + ".txt"
         End If

         ' Rename the output from a .TXT2 file to .TXT file
         If sJDBC = "No" AND FileExists(sPath + sOutputFileName + ".txt2")
THEN
            Name sPath + sOutputFileName + ".txt2" as sPath +
sOutputFileName + ".txt"
         End If

         ' Rename the output from a .TXT2 file to .TXT file
         If sJDBC = "Yes" AND FileExists(sPath2 + sOutputFileName +
".txt2") THEN
            Name sPath2 + sOutputFileName + ".txt2" as sPath +
sOutputFileName + ".txt"
         End If

      End If

   Else '<<< No Header, but, Rename it

      ' Rename the output from a .TXT2 file to .TXT file in correct
directory
      If sJDBC = "Yes" AND FileExists(sPath2 + sOutputFileName + ".txt")
THEN
         Name sPath2 + sOutputFileName + ".txt" as sPath + sOutputFileName
+ ".txt"
      End If

   End If
   '= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = =


   GoTo TheEnd   'skip over SQLErrorHandler when no SQL errors

   SQLErrorHandler:
   sErrorMsg = "Error: " & Err & ", line " & Erl & " in (" & sFunctionName
& "). " & Chr$(13) & Chr$(13) & Error$
   msgbox (sErrorMsg, 16, "ErrorHandler")
   Exit Function

   TheEnd:   'The Macro is now ending

   'Informational Message Box to indicate Name of Newly Created File Name
   BEEP   '<< BEEP User that Macro complete, and, Display new File Info in
msgbox
   msgbox ( "Your new file exists as: " &_
            + Chr$(13) + Chr$(13) + sOutputFileName + ".txt" + Chr$(13) +
Chr$(13),64, "New txt file created")

End Function   'ExportHSQL


' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = = = = = = =

Function ReplaceString_ExportHSQL(Source As String, Search As
String,NewPart as String)
   ' This Function will ONLY 'replace' the 'From ' part of the Query ONCE,
the first time it finds it
   ' Therefore, SubQueries will be allowed . . . BUT . . . if field
name/alias contains 'From '
   ' That is a From and a single space . . . this will not work.
   Dim Result as String
   Dim Startpos as Long
   Dim CurrentPos as Long

   Result = ""
   StartPos = 1
   CurrentPos = 1
   'NoOfReplacements = 0

      If search = "" Then
               Result = Source
      Else
         Do While CurrentPos <> 0
            CurrentPos = InStr(StartPos, Source, Search)
            If CurrentPos <> 0 Then
               Result = Result + Mid(Source, StartPos, CurrentPos -
StartPos)
               Result = Result + NewPart
               NewPart = "FROM "   'Since have found the FIRST "FROM " and
do NOT replace it for any SubQuery
               StartPos = CurrentPos + Len(Search)
            Else
               Result = Result + Mid (Source, StartPos, Len (Source))
            End if
         Loop
      End If

      ReplaceString_ExportHSQL = Result

End Function   'ReplaceString_ExportHSQL



' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = = = = = = =
' This function will get all the table names in sDBName, and, using
sHeader, pass it back to create txt files
Function ExportAllTables(Optional sHeader as String, Optional sDBName as
String)

   oDatabaseContext = createUnoService( "com.sun.star.sdb.DatabaseContext"
)

   oDBSource = oDatabaseContext.GetByName(sDBName)

   oConnection = oDBSource.GetConnection("SA", "")   
   oStatement = oConnection.createStatement()

   ' This SQL will return, in alphabetical order, one value for each
'cached' HSQL table
   sSQLString = "SELECT ""TABLE_NAME"" " + _
                "FROM ""INFORMATION_SCHEMA"".""SYSTEM_TABLES"" " + _
                "WHERE ""HSQLDB_TYPE"" = 'CACHED' " +_
                "ORDER BY UPPER(""TABLE_NAME"")"

   oTableNameSet = oStatement.executeQuery( sSQLString )

   '<<< Get the Valid Table Names - so can output text files
   rownum = 0
   While oTableNameSet.next
      sTableName = oTableNameSet.getString(1)   '<<< 1 is the Column Number
      sOutputFileName = sTableName + "_" + CDateToIso(Date) + "_txt"

      ExportHSQL(sTableName,sOutputFileName,sHeader,sDBName)

      rownum = rownum + 1
   wEnd

End Function   'ExportAllTables

' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = = = = = = =
' This function will open the dialog box for Foto Katalog

Sub Help_FotoKat

Dim Dlg As Object

DialogLibraries.LoadLibrary("Standard")
Dlg = CreateUnoDialog(DialogLibraries.Standard.Help_FK)
Dlg.Execute()
Dlg.dispose()

End Sub

' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= = = = = = = = = = = =

sub Update_NoOfPhotos
' Används inte
dim oForm               as object
dim oField              as object
dim CtlView             as object

Rem Set Focus on control
'Get Form'
    oForm = ThisComponent.Drawpage.Forms.getByName("NoOfPhotos")
'Get Field'
    oField = oForm.getByName("Txt_NoOfPhotos")
'Get field VIEW'
    CtlView = ThisComponent.getCurrentController().getControl(oField)
'Set Focus'
    CtlView.setFocus()
Rem update NoOfPhotos
' Update form
    oForm.reload()
End sub

Sub SetRecDateInForm (oEvent As Object)
    oForm = oEvent.Source
    lDateCol = oForm.findColumn("RecDate")
     dateStamp = Format(Now, "YYYY-MM-DD")
    If oForm.getString(lDateCol) = "2000-01-01" then
    oForm.updateString(lDateCol, dateStamp)
    End If

End Sub

[RPG]

In the code you can find a link to the original code:
viewtopic.php?f=13&t=26843&p=122081&hil ... ES#p122081
You can read that the code is for using as calc functions not for buttons.

[AfTech54]

Thanks Tibor!
Strange because last time I used it with the button was in January 2023 and then both buttons worked fine. So something must have happened.
I'm using Base to record all our photos and movies with for instance persons, places and time. The form allow me to search specific photos then I extrude the filenames in the csv-file with the button and it have really worked for me several years. I can't remind me of that I've done any updates to the macros or the Base, but I'm an old man so I might have forgot it
Well I can still execute the macro outside the form, so I probably hav to live with that if I can't find any solution.
Thanks again and best regards.
Roger

[Villeroy]

Choose the highest security level.
Specify your document folder as trusted source. This is the place where you store documents with embedded macros.
Do not specify the downloads folder because this is the place where potentially untrusted stuff is stored by default.

The global macros you have installed in your user profile (under "My Macros") are trusted anyway. The security level relates to the macros that are embedded in documents.
If you upgrade from OpenOffice to LibreOffice, any document trying to call any macro needs to be stored in a trusted directory, even if the document has no code embedded.

[AfTech54]

Hi and thanks Villeroy!

I've tried it before, did it again and restarted the laptop. Buttons still not executing the macros.
I've attached some more screenshots if that might help.

I've the same problem on my laptop as well as on the stationary computer.
I'm using Windows 10 and OOO 4.1.15 on both 64b comp.
I'm storing my "Base-doc" on Onedrive and simultaneously on a local HD on both computers.

Could it be Windows that is not allowing macros??
I tried to find something to alter in Windows settings regarding macros but I didn't find any.

//Roger

[AfTech54]

I tried to add a shortcut command ctrl+H to one of the macros and that didn't work either.
So I think it might be a bug??
Could somebody try if it's possible to execute a macro within a document with OO v.4.1.15.

[AfTech54]

THANKS Villeroy!!

Well it took sometime for this old man to understand what you ment, I set the documents folder to a trusted folder and now it works!

//Roger