Yaslaw.Info > VB / VBA > [VBA] Oracle Helper Class
Impressum Stopp Acta

[VBA] Oracle Helper Class

Ich arbeite gerade an einem Projekt wo Access das GUI stellt, die Daten jedoch in Oracle gespeichert sind (zum Glück!). Für die Imports etc. verwende ich slqldr und um grössere Updates abzusetzen sqlplus. Diese steuer ich aus Access an.

Anwendungen
    Erstellen und Ausführen eines sqlplus-Scriptes
    Recalculate einer MView
Die zugrundeliegenden Klassen
    OraHelper - Die Helferklasse
    Mein dazugehöriges Module 'StaticClass'



Anwendungen


Erstellen und Ausführen eines sqlplus-Scriptes

  1. Erstellen eines Script-Files
  2. Ausführen über sqlplus
  3. ggf Auswerten des Spools
Dim sql     as String

sql = "DELETE FROM my_table WHERE to_date < TO_DATE(20111231, 'YYYYMMDD');"
call OraHelper.createAndRunScript(sql, "DELETE_OLD_DATA.sql",,True)



Recalculate einer MView

Call OraHelper.recalculateMView("MV_MY_MVIEW", false)



Die zugrundeliegenden Klassen


OraHelper - Die Helferklasse

Folgende weitere Klassen/Funktionen/Patterns werden verwendet

OraHelper
'-------------------------------------------------------------------------------
'mpl          by ERB software
'Environment  Access 2000 und höher
'Author       Stefan Erb (ERS)
'History      22.12.2011 - ERS - Creation
'-------------------------------------------------------------------------------

'/**
' * Benötigt das printF-Module von Phlip Bradbury
' * http://www.freevbcode.com/ShowCode.asp?ID=5014
' * Die Funktion sprintF() aus diesem Modul wird in dieser Klasse an diversen Orten eingesetzt.
' * um Werte in einen String zu parsen.
' */

'/**
' * @example zum statischen gebrauch
' *     Public Function OraHelper() As OraHelper
' *         If staticOraHelper Is Nothing Then
' *             Set staticOraHelper = New OraHelper
' *             staticOraHelper.sqlScriptFolderPath = "ORA-Loader\TempSQL"
' *         End If
' *         Set OraHelper = staticOraHelper
' *     End Function
' * @example aufruf der "statischen" Klasse
' *     Call OraHelper.recalculateMView("MV_ADDRESSES", FALSE)
' */

Option Compare Database
Option Explicit


'-------------------------------------------------------------------------------
' Private members
'-------------------------------------------------------------------------------
Const C_PATTERN_IS_ABSOLUTE_PATH As String = "^(?:[A-Z]:\\|\\\\)"   'String beginnt mit Grussbuchstabe gefolgt von ':\' oder aus \\

Dim staticSqlScriptFolderPath   As String
Dim staticSpoolFolderPath       As String
Dim staticOraLogin              As String   'schema/password@database


'-------------------------------------------------------------------------------
' Public members
'-------------------------------------------------------------------------------

'/**
' * Oracle Login-Informateion in der Schreibweise 'schema/password@database'
' */
Public Property Let oraLogin(ByVal iOraLogin As String)
    staticOraLogin = iOraLogin
End Property

Public Property Get oraLogin() As String
    oraLogin = staticOraLogin
End Property

'/**
' * setzt den Pfad zum Scriptordner, Absolut oder Rekursiv von der Access-DB aus
' * @param  String      Absoluter oder relativer Pfad
' */
Public Property Let sqlScriptFolderPath(ByVal iSqlScriptFolderPathRekursive As String)
    If Not isAbsolutePath(iSqlScriptFolderPathRekursive) Then
        'Ordnerpfad erstellen
        staticSqlScriptFolderPath = FSO.BuildPath(FSO.GetFile(CurrentDb.Name).ParentFolder.Path, iSqlScriptFolderPathRekursive)
    Else
        staticSqlScriptFolderPath = iSqlScriptFolderPathRekursive
    End If
    'prüfen ob der Ordnerpfad existiert - ansonsten anlegen
    If Not FSO.FolderExists(staticSqlScriptFolderPath) Then Call FSO.CreateFolder(staticSqlScriptFolderPath)
End Property

'/**
' * @return String      Absoluter Pfad
' */
Public Property Get sqlScriptFolderPath() As String
    sqlScriptFolderPath = staticSqlScriptFolderPath
End Property

'/**
' * setzt den Pfad zum Spoolordner, Absolut oder Rekursiv von der Access-DB aus
' * @param  String      Absoluter oder relativer Pfad
' */
Public Property Let spoolFolderPath(ByVal iSpoolFolderPathRekursive As String)
    If Not isAbsolutePath(iSpoolFolderPathRekursive) Then
        'Ordnerpfad erstellen
        staticSpoolFolderPath = FSO.BuildPath(FSO.GetFile(CurrentDb.Name).ParentFolder.Path, iSpoolFolderPathRekursive)
    Else
        staticSpoolFolderPath = iSpoolFolderPathRekursive
    End If
    'prüfen ob der Ordnerpfad existiert - ansonsten anlegen
    If Not FSO.FolderExists(staticSpoolFolderPath) Then Call FSO.CreateFolder(staticSpoolFolderPath)
End Property

'/**
' * @return String      Absoluter Pfad
' */
Public Property Get spoolFolderPath() As String
    spoolFolderPath = staticSpoolFolderPath
End Property


'-------------------------------------------------------------------------------
' Private methodes
'-------------------------------------------------------------------------------

'/**
' * Prüft ob der String einem Pfad entspricht
' * @param  String      zu prüfender Pfad
' * @return Boolean     Prüfresultat
' */
Private Function isAbsolutePath(ByVal item As String) As Boolean
    RegExp.Pattern = C_PATTERN_IS_ABSOLUTE_PATH
    isAbsolutePath = RegExp.test(item)
End Function

'/**
' * Erstellt ein FilePfad zum Script-File, Rekursiv von der Access-DB aus
' * @param  String      Name des Scriptes
' * @return String      Pfad zum Scriptfile
' */
Private Function buildScriptFilePath(ByVal iScriptName As String) As String
    If Not isAbsolutePath(iScriptName) Then
        'Dateipfad erstellen
        buildScriptFilePath = FSO.BuildPath(sqlScriptFolderPath, SPrintF("%s.sql", iScriptName))
    Else
        'Es handelt sich bereits um einen absoluten Pfad
        buildScriptFilePath = iScriptName
    End If
End Function


'-------------------------------------------------------------------------------
' Public methodes
'-------------------------------------------------------------------------------

'/**
' * createAndRunScript
' * Erstellt ein SQLPlus-Script aus einem SQL-String und führt es aus
' * @param  String          SQL-Script
' * @param  String          Pfad wo das Script gespeichert werden soll
' * @param  String          Pfad der Spool-Datei
' */
Public Sub createAndRunScript( _
            ByVal script As String, _
            ByVal scriptFileName As String, _
            Optional ByVal spoolPath As String = vbNullString, _
            Optional ByVal deleteFilesAfterRun As Boolean = False _
)
    Dim scriptPath      As String
   
    scriptPath = createScriptFile(script, scriptFileName, spoolPath)
    Call sqlPlus(scriptPath)
   
    'Script- und Spooldateien löschen
    If deleteFilesAfterRun Then
        Call FSO.DeleteFile(scriptPath)
        If Not spoolPath = vbNullString Then Call FSO.DeleteFile(spoolPath)
    End If
End Sub

'/**
' * sqlPlus
' * Führt eine Scriptdatei mit SQLPlus aus
' * @param  String          Pfad wo das Script gespeichert werden soll
' */
Public Sub sqlPlus(ByVal scriptFileName As String)
    Dim shellCommand     As String
    Dim scriptPath      As String

    scriptPath = buildScriptFilePath(scriptFileName)
   
    shellCommand = "sqlplus %s @""%s"""
    shellCommand = SPrintF(shellCommand, oraLogin, scriptPath)
    'shellwait von http://bytes.com/topic/access/insights/841878-shellwait-function
    shellWait(shellCommand, True)

End Sub


'/**
' * createScriptFile
' * Erstellt ein SQLPlus-Script aus einem SQL-String
' * @param  String          SQL-Script
' * @param  String          Name der Scriptdatei
' * @param  String          Pfad der Spool-Datei
' * @return String          Pfad wo das Script gespeichert ist
' */
Public Function createScriptFile( _
            ByVal script As String, _
            ByVal scriptFileName As String, _
            Optional ByVal spoolPath As String = vbNullString _
) As String
    Dim stream          As TextStream
    Dim scriptPath      As String
    Dim withSpool       As Boolean

    withSpool = Not spoolPath = vbNullString
    scriptPath = buildScriptFilePath(scriptFileName)

    Set stream = FSO.CreateTextFile(scriptPath, True)
    With stream
        If withSpool Then Call .WriteLine(SPrintF("SPOOL ""%s"";", spoolPath))
        Call .WriteBlankLines(1)
        Call .WriteLine(script)
        Call .WriteBlankLines(1)
        Call .WriteLine("COMMIT;")
        If withSpool Then Call .WriteLine("SPOOL OFF;")
        Call .WriteLine("EXIT;")
        Call .Close
    End With
    Set stream = Nothing
   
    createScriptFile = scriptPath
End Function

'/**
' * recalculateMView
' * Macht ein refresh() auf eine MView
' * @param  String      Name der MView
' * @param  Boolean     Rückfrage ob der refresh wirklich durchgeführt werden soll
' */
Public Sub recalculateMView(ByVal mvName As String, Optional ByVal confirm As Boolean = True)
    Dim sqlFileName         As String
    Dim sql                 As String
    Dim pathLoader          As String
   
    If confirm Then
        If vbYes <> MsgBox(SPrintF("Die MView %s neu laden? Dieser Vorgang kann einige Minuten dauern", mvName), vbQuestion + vbYesNo + vbDefaultButton1) Then
            Exit Sub
        End If
    End If
   
    sqlFileName = SPrintF("MVEIW_REFRESH_%s", mvName)
   
    sql = SPrintF("exec dbms_mview.refresh( '%s');", mvName)
   
    Call createAndRunScript(sql, sqlFileName)
   
End Sub

'/**
' * relinkt gelinkte Oracle-Tabellen. Wenn sich die Struktur der Tabelle verändert, ist das zwingend
' * @param  String      Link-Name der Tabelle. Wenn dieser Parameter leer bleibt, werden alle gelinkten Tabellen neu gelinkt
' */
Public Sub relinkTables(Optional ByVal iTableName As String = vbNullString)
    Dim rs              As DAO.Recordset
    Dim objNames()      As String
    Dim objName         As Variant

    If iTableName = vbNullString Then
        Set rs = CurrentDb.OpenRecordset("SELECT [Name] AS objname FROM MSysObjects WHERE TYPE = 4 ORDER BY [Name]")
        Call rs.MoveFirst
        Do While Not rs.BOF And Not rs.EOF
            Call pushArray(objNames, rs!objName)
            rs.MoveNext
        Loop
   
        Call rs.Close
        Set rs = Nothing
    Else
        Call pushArray(objNames, iTableName)
    End If
   
    For Each objName In objNames
        If Not objName Like "~*" Then
            Debug.Print "Refresh Link to " & objName
            Call CurrentDb.TableDefs(objName).RefreshLink
        End If
    Next objName
   
    Debug.Print "relinkTables Fertig !"
End Sub

'/**
' * getOraName
' * Erstellt aus einem String einen gültigen Oracle-Namen
' * @example:
' *     Dim num     As Integer
' *     num = 1
' *     Debug.Print OraHelper.getOraName("Strassen & Nr", num)
' *     Debug.Print OraHelper.getOraName("Verkehrsberuhigung südlicher Gehweg", num)
' *     Debug.Print OraHelper.getOraName("Verkehrsberuhigung Fahrradstreifen", num)
' *     --> Ausgabe: STRASSEN___NR, VERKEHRSBERUHIGUNG_S_DLICHE_01, VERKEHRSBERUHIGUNG_FAHRRADS_02
' * @param  String      Name der gewandelt werdn soll
' * @param  Integer     Laufnummer falls der Name gekürzt werden muss
' * @return String      gültiger Oracle name
' */
Public Function getOraName( _
        ByVal iAccessName As String, _
        Optional ByRef ioNumber As Integer = 1 _
) As String

    RegExp.IgnoreCase = True
    RegExp.Global = True
   
    RegExp.Pattern = "([ä])"
    getOraName = RegExp.Replace(UCase(iAccessName), "AE")
   
    RegExp.Pattern = "([\W])"
    getOraName = RegExp.Replace(getOraName, "_")
   
   
    If Len(getOraName) > 30 Then
        getOraName = SPrintF("%s_%s", Left(getOraName, 27), Format(ioNumber, "00"))
        ioNumber = ioNumber + 1
    End If

End Function



Mein dazugehöriges Module 'StaticClass'

StaticClass
'-------------------------------------------------------------------------------

Option Explicit
Option Compare Database

'-------------------------------------------------------------------------------
' Private members
'-------------------------------------------------------------------------------
Public Const C_ORA_SCHEMA = "my_schema"
Public Const C_ORA_PWD = "my_password"
Public Const C_ORA_DATABASE = "my_database"

Public Const C_ORA_LOGIN = C_ORA_SCHEMA & "/" & C_ORA_PWD & "@" & C_ORA_DATABASE

Private staticOraHelper             As OraHelper
Private staticFSO                   As FileSystemObject
Private staticRegExp                As RegExp


'-------------------------------------------------------------------------------
' Public methodes
'-------------------------------------------------------------------------------
Public Function OraHelper() As OraHelper
    If staticOraHelper Is Nothing Then
        Set staticOraHelper = New OraHelper
       
        staticOraHelper.oraLogin = C_ORA_LOGIN
        staticOraHelper.sqlScriptFolderPath = "ORA-Loader\TempSQL"
        staticOraHelper.spoolFolderPath = "ORA-Loader\LogFiles"
    End If
    Set OraHelper = staticOraHelper
End Function

Public Function FSO() As FileSystemObject
    If staticFSO Is Nothing Then Set staticFSO = New FileSystemObject
    Set FSO = staticFSO
End Function

Public Function RegExp() As RegExp
    If staticRegExp Is Nothing Then Set staticRegExp = New RegExp
    Set RegExp = staticRegExp
End Function
Valid XHTML 1.0 Transitional :: Valid CSS :: Powered by WikkaWiki