User Tools

Site Tools


vba:access:orahelper

[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

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
vba/access/orahelper.txt · Last modified: 09.12.2013 09:39:54 (external edit)