Copies the specified Sheet from multiple Documents in a specific folder to a new Document. The code must be in My Macros.

The code must be in My Macros
Copies the specified Sheet from multiple Documents in a specific folder to a new Document.

' The code must be in My Macros

' Copies the specified Sheet from multiple Documents in a specific folder to a new Document.

Sub DiffdocUntitledDocShCopy

    Dim untitledDoc As Object

    Dim fromDoc As Object

    Dim Dummy()

    Dim strResult As String

    Dim sheetName As String

    

    untitledDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())

    untitledDocName = untitledDoc.Title

  Mid(untitledDocName, Len(untitledDocName)-1, 1,"")  ' <= Remove whitespace Ver5.2 necessary, Ver5.3 Unnecessary

    

    strResult = Dir("C:/sample/*.ods",0)

    Do While strResult <> ""

        strUrl = ConvertToUrl("C:/sample/" &  strResult)

        fromDoc = StarDesktop.loadComponentFromURL(strUrl, "_blank", 0, Array())

        sheetName = "test"

        If fromDoc.Sheets.hasByName(sheetName) Then

            fromDoc.CurrentController.setActiveSheet( fromDoc.Sheets.getByName(sheetName))

            diffdUntitleddShCp(fromDoc, untitledDocName)

            'diffdUntitleddShCp(fromDoc, untitledDocName)     '  <= Twice

        End If

        fromDoc.close(True)

        strResult = Dir

    Loop

      'untitledDoc.close(True)   

End sub
Sub diffdUntitleddShCp(fromDoc,     untitledDocName)

    Dim frame as Object

    Dim dispatcher as Object

    Dim args1(2) as new com.sun.star.beans.PropertyValue
    frame =  fromDoc.CurrentController.Frame

    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    args1(0).Name = "DocName"

    args1(0).Value = untitledDocName

    args1(1).Name = "Index"

    args1(1).Value = 32767    '  <=　When moving to the back

    args1(2).Name = "Copy"

    args1(2).Value = true       '  <=　Move is false, Copy is true

    dispatcher.executeDispatch(frame, ".uno:Move", "", 0, args1())

End Sub