STAEMAddIn.SelectObject

SVB Example

Interactively selecting a folder:

Option Base 1
Option Explicit

Type Options
    bMajorRevision As Boolean
    bApproveChanges As Boolean
    strLogReason As String
    strApprovalType As String
End Type

Dim gOM As ObjectManager
Dim gOptions As Options

Dim gApprovalTypes() As String

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

'Used to create a unique GUID
Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Sub Main

    'This macro prompts for a source and destination folder, then recursively copies
    'all spreadsheet documents to the destination, duplicating the child folder structure.
    'If the destination spreadsheet is not found, then it is created.
    'If it is found, then the existing one is updated.
    'It also optionally approves the documents in the destination.

    'Note that this example requires these references:
    'STATISTICA SPC Extension 1.0 Object Library
    'STAEMAddInLib 1.0 Type Library
    'Microsoft Shell Controls And Automation

    Set gOM = New ObjectManager
    gOM.Reconnect(Application)

    Dim oSrcFolder As SPCFolder
    Set oSrcFolder = SelectFolder("Select Source Folder")
    If oSrcFolder Is Nothing Then Exit Sub

    Dim oDestFolder As SPCFolder
    Set oDestFolder = SelectFolder("Select Destination Folder")
    If oDestFolder Is Nothing Then Exit Sub

    If oSrcFolder.ID = oDestFolder.ID Then Err.Raise 1,, _
        "Source and destination folders cannot be the same"

    If Not GetOptions() Then Exit Sub

    ProcessFolder(oSrcFolder, oDestFolder.PathEx(False, True))

End Sub

Sub ProcessFolder(oSrcFolder As SPCFolder, ByVal strDestinationPath As String)

    Dim objArray, i As Long, m As Monitor
    objArray = oSrcFolder.List(swcMonitor)

    Dim doc As BinaryDocument
    objArray = oSrcFolder.List(swcBinaryDocument)
    For i = LBound(objArray) To UBound(objArray)
        Set doc = objArray(i)
        'handle spreadsheet document types only;
        'add new extensions here to support other doc types
        If UCase(doc.Type) = "STA" Then
            CopyBinaryDoc(doc, strDestinationPath)
        End If
    Next

    'now process child folders
    Dim child As SPCFolder
    Set child = oSrcFolder.FirstChild
    While Not child Is Nothing
        ProcessFolder(child, strDestinationPath + "/" + child.Name)
        Set child = child.Next
    Wend

End Sub

Sub CopyBinaryDoc(oSrcDoc As BinaryDocument, strDestinationPath As String)

    Dim strDestPath As String
    strDestPath = strDestinationPath + "/" + oSrcDoc.Name + "." + oSrcDoc.Type

    Dim oDestDoc As BinaryDocument
    On Error Resume Next
    Set oDestDoc = gOM.BinaryDocuments.Item(strDestPath)
    On Error GoTo 0

    Dim bdui As New BinaryDocumentUpdateInfo

    If oDestDoc Is Nothing Then
        'does not exist, create a new one
        Dim oFolderDest As SPCFolder
        Set oFolderDest = FindOrCreateFolder(strDestinationPath)

        Dim ci As New CloneInfo
        ci.AuditLogReason = gOptions.strLogReason
        'CloneEx will not work with doc that has the name as
        'the target name, so append a unique GUID
        ci.Name = oSrcDoc.Name + " " + GetGUID
        ci.SamePermission = True
        ci.SamePlacement = False

        Set oDestDoc = oSrcDoc.CloneEx(ci)

        Dim fui As New FolderUpdateInfo
        fui.AuditLogReason = gOptions.strLogReason
        oFolderDest.AttachEx(oDestDoc, fui)

        bdui.AuditLogReason = gOptions.strLogReason
        bdui.DocumentComment = gOptions.strLogReason
        bdui.BumpDocumentVersion = gOptions.bMajorRevision

        oDestDoc.AutoSave = False
        oDestDoc.Name = oSrcDoc.Name
        oDestDoc.SaveEx(bdui)

        gOM.BinaryDocuments.Refresh

    Else
        'update existing
        bdui.AuditLogReason = gOptions.strLogReason
        bdui.DocumentComment = gOptions.strLogReason
        bdui.BumpDocumentVersion = gOptions.bMajorRevision
        oDestDoc.AutoSave = False
        oDestDoc.Data = oSrcDoc.Data
        oDestDoc.SaveEx(bdui)
    End If

    If gOptions.bApproveChanges Then
        gOM.SDMSHelper.ApproveBinaryDocumentSDMSDocument(0, _
            oDestDoc.ID, oDestDoc.Revision, gOptions.strApprovalType, gOptions.strLogReason)
    End If

End Sub

Function FindOrCreateFolder(sPath As String) As SPCFolder

    Dim f1 As SPCFolder, f2 As SPCFolder
    Set f1 = gOM.FindFolder(sPath)
    If Not f1 Is Nothing Then Return f1

    Dim v, i
    If Left(sPath, 1) = "/" Then
        sPath = Mid(sPath, 2)
    End If
    v = Split(sPath, "/")

    Dim ci As FolderCreateInfo

    Set f1 = gOM.RootFolder
    For i = LBound(v) To UBound(v)
        On Error Resume Next
        Set f2 = Nothing
        Set f2 = f1.FindByType(v(i), swcFolder, 0, 0)
        On Error GoTo 0
        If f2 Is Nothing Then
            Set ci = New FolderCreateInfo
            ci.AuditLogReason = gOptions.strLogReason
            ci.Name = v(i)
            Set f2 = f1.NewFolderEx(ci)
        End If
        Set f1 = f2
    Next
    Return f1

End Function

Function GetApprovalType() As Boolean

    Begin Dialog UserDialog 400,175,"Select Approval Type",.GetApprovalTypeDialogFunc '%GRID:10,7,1,1
        DropListBox 40,21,270,98,gApprovalTypes(),.approvalTypeLB
        OKButton 210,154,90,21
        CancelButton 310,154,90,21
    End Dialog

    Dim dlg As UserDialog
    Dim nDlgResult As Long
    nDlgResult = Dialog(dlg)
    If nDlgResult = 0 Then Return False

    gOptions.strApprovalType = gApprovalTypes(dlg.approvalTypeLB)
    Return True

End Function

Private Function GetApprovalTypeDialogFunc(DlgItem$, Action%, SuppValue?) As Boolean

    Select Case Action%
        Case 1 'Dialog box initialization
        Case 2 'Value changing or button pressed
        Case 3 ' TextBox or ComboBox text changed
        Case 4 ' Focus changed
        Case 5 ' Idle
        Case 6 ' Function key
    End Select

End Function

Function GetOptions() As Boolean

    Begin Dialog UserDialog 360,203,.GetOptionsDialogFunc ' %GRID:10,7,1,1
        CheckBox 30,21,110,14,"Major Revision",.majorRevision
        CheckBox 30,49,130,14,"Approve Changes",.approveChanges
        Text 30,77,190,14,"Audit Log Reason/Comment:",.logReasonLabel
        TextBox 60,98,290,63,.logReason,1
        OKButton 160,175,90,21
        CancelButton 260,175,90,21
    End Dialog

    Dim dlg As UserDialog
    Dim nDlgResult As Long
    nDlgResult = Dialog(dlg)
    'Stop
    If nDlgResult = 0 Then Return False

    gOptions.bMajorRevision = dlg.majorRevision
    gOptions.bApproveChanges = dlg.approveChanges
    gOptions.strLogReason = dlg.logReason

    If gOptions.bApproveChanges AndAlso _
        gOM.SystemOptions.SDMSIntegration.Enabled AndAlso _
        gOM.SystemOptions.SDMSIntegration.MonitorVersioning Then

        gApprovalTypes = gOM.SDMSHelper.ApprovalTypes(0)

        If Not GetApprovalType() Then Return False

    End If

    Return True

End Function

Function GetOptionsDialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
    Dim i As Long
    Select Case Action
    Case 1 ' Dialog box initialization
    Case 2 ' Value changing or button pressed

        If DlgItem = "OK" Then
            If Len(DlgText(3))=0 AndAlso gOM.SystemOptions.AuditLog.RequireReason Then
                MsgBox "The audit log reason is required"
                GetOptionsDialogFunc = True
            Else
                GetOptionsDialogFunc = False
            End If
        End If

    End Select

End Function


Function SelectFolder(sCaption As String) As SPCFolder

    'EnterpriseAddIn offers additionaly functionality to Enterprise
    Dim em As EnterpriseAddIn
    Set em = AddIns.AddIn("STAEMAddIn.STAEMAddIn.1")
    'Use the EnterpriseAddIn object to interatively select a folder
    Dim Folder As SPCFolder
    em.SelectObject(sCaption, semFolder, semAllowCreateFolder, Empty, 0, Folder)
    Set SelectFolder = Folder

End Function

Public Function GetGUID() As String

    Dim udtGUID As GUID
    If (CoCreateGuid(udtGUID) = 0) Then

        GetGUID = _
            String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _
            String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _
            String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _
            IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
            IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _
            IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
            IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
            IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
            IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
            IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
            IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))
    End If

End Function