======[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}}