======[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====
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
*[[.:StaticClass]] für das FSO und RegExp
*[[..:functions:printf]]
*Die [[http://bytes.com/topic/access/insights/841878-shellwait-function|shellwait Funktion]]
'-------------------------------------------------------------------------------
'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'====
'-------------------------------------------------------------------------------
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
{{tag>VBA Oracle}}