OnBase VBScript to Export a File

Updated script: VBScript and API to export all image pages

Link to other Onbase scripts.

I spent too much time looking for a script example for exporting from OnBase the other day, so I wrote one that works within OnBase. It can be run as a script hook. The key to figuring this out was to find the table with the “file path” values in it. After rummaging around for a while I found the “itemdatapage” table which has part of the path in it. The other part (the diskgroup) has to be included in the path, plus the share drive value.

The following are the parameters that need to be set in order for the script to run correctly.

·         Database connection

o   Const CONNECTSTRING = "DSN=onbase;UID=hsi;PWD=xxxxxx"

·         Destination of copy

o   DestinationFolder = “\\\”

o   DestinationFile = DestinationFolder & oDoc.Handle & ".TIF"

·         Source of file

o   FileSystemPath = Trim(oRecordSet(0)) & Trim(oRecordSet(1))

o   SourceFile =  "\\

Script Code

Test

Sub Main35()

Const CONNECTSTRING = "DSN=onbase;UID=hsi;PWD=xxxxxxx"

' Root level OnBase Automation object

  Dim oApp

  Set oApp = CreateObject("OnBase.Application")

  Dim oDoc

  Dim cKWs

  Set oDoc = oApp.CurrentDocument

  Set cKWs = oDoc.Keywords

  Dim sSQL

  Dim oRecordSet

  Dim oConn

  Dim i

  Dim FileSystemPath

 'MsgBox "oDoc.Handle:" & oDoc.Handle

  'open connection

  Set oConn = CreateObject("ADODB.Connection")

  oConn.Open CONNECTSTRING

  sSQL = "SELECT b.diskgroupname, a.filepath FROM HSI.itemdatapage a, hsi.diskgroup b WHERE itemnum =  "& oDoc.Handle &"  AND a.diskgroupnum = b.diskgroupnum"

 'MsgBox "sSQL: " & sSQL

  'Get recordset by executin query

  Set oRecordSet = CreateObject("ADODB.Recordset")

  Set oRecordSet = oConn.Execute(sSQL)

  If Not oRecordSet.EOF Then

       'MsgBox "Trim(oRecordSet(0)): " & Trim(oRecordSet(0))

       'MsgBox "Trim(oRecordSet(1)): " & Trim(oRecordSet(1))

      FileSystemPath = Trim(oRecordSet(0)) & "117" & Trim(oRecordSet(1))

  End If

 'MsgBox FileSystemPath

 ' Call oDoc.StoreKeywords()

  oRecordSet.Close

  Set oRecordSet = Nothing 

  oConn.Close

Dim DestinationFolder

DestinationFolder = "\\destination share drive\"

'MsgBox DestinationFolder

Dim DestinationFile

DestinationFile = DestinationFolder & oDoc.Handle & ".TIF"

'MsgBox DestinationFile

Dim SourceFile

SourceFile =  "\\

'MsgBox SourceFile

Set fso = CreateObject("Scripting.FileSystemObject")

    'Check to see if the file already exists in the destination folder

    If fso.FileExists(DestinationFile) Then

      'Check to see if the file is read-only

      If Not fso.GetFile(DestinationFile).Attributes And 1 Then

            'The file exists and is not read-only.  Safe to replace the file.

            fso.CopyFile SourceFile, DestinationFolder, True

      Else

            'The file exists and is read-only.

            'Remove the read-only attribute

            fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1

            'Replace the file

            fso.CopyFile SourceFile, DestinationFolder, True

            'Reapply the read-only attribute

            fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1

      End If

    Else

      'The file does not exist in the destination folder.  Safe to copy file to this folder.

      fso.CopyFile SourceFile, DestinationFolder, True

            'MsgBox "file copied"

    End If

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.GetFile(SourceFile)

Dim SourceCopiedFile

SourceCopiedFile = DestinationFolder & objFSO.GetFileName(objFile)

fso.MoveFile SourceCopiedFile, DestinationFile

     

Set fso = Nothing

Set objFSO = Nothing

  Set oConn = Nothing

  Set cKWs = Nothing

  Set oDoc = Nothing

  Set oApp = Nothing

End Sub 'Main35()