Download udf_joinsql.bas (V-1.0.0)

Ich komme immer wieder zu dem Punkt, wo ich einmalig aus einer Excel-Tabelle SQL-Insert-Scripts erstellen muss. Bisher habe ich das von Hand mit Formeln zusammengeschustert. Jetzt habe ich aber eine VBA-Funktion geschrieben, die mir das mehr oder weniger abnimmt.

'/**
' * Setz ein einfaches Insert zusammen
' * @example    =joinSql("MY_TABLE"; A$9:Q$9; A11:Q11; A$10:Q$10)
' *
' * @param  Cell/String     Name der Zieltabelle
' * @param  Range           Range mit den Spaltennamen
' * @param  Range           Range mit den Daten (eine Zeile)
' * @param  Range           Range mit den Datentypzuweisung. Die Typenzuweisung ist typ & attribut.
' * @param  String          Name der Sqeunez
' * @return String
' */
Public Function joinSql( _
        ByVal iTableName As String, _
        ByRef iHeaderRange As Range, _
        ByRef iDataRange As Range, _
        Optional ByRef iTypeRange As Range, _
        Optional ByVal iSequenceName As String _
) As String

• s String text → 'text'
• d Datum 1.2.2016 → TO_DATE('02/01/2016', 'MM/DD/YYYY')
• i SEQUENZ.NEXTVAL
• x Spalte unterdrücken
• Wert unverändert zurückgeben

• n Standard: NULL
• e Empty: “”
• 0 Null: 0
• t SYSDATE

• Wenn die Spalte keinen Eintrag im HeaderRange hat, wird sie unterdrück
• Unordered List ItemSpalten, welche im TypeRange 'x' drin haben, werden ebenfalls unterdrückt
• Die Attribute zur Nullregelung können dem Type angehängt werden

• sn → Feld ist ein String, wenn kein Wert vorhanden ist wird der Text NULL ausgegeben
• se → Wieder ein String. Aber der Leerwert wird als “” ausgegeben
• s → Wie sn
• 0 → ohne formatierung. Ein Leerwert wird als 0 ausgegeben
• etc.

Und hier noch der Code zu den oben bechreibenen Funktionen

Dieser Coder ist für Oracle geschrieben. Für andere DBMS müssend ie Konstanten C_DATE_FORMAT und C_DATE_TIMESTAMP ersetzt werden

udf_joinsql.bas

Attribute VB_Name = "udf_joinSql"
'-------------------------------------------------------------------------------
'File         : udf_joinSql.bas
'Environment  : Excel VBA 2010 +
'Version      : 1.0.0
'Name         : joinSql
'Author       : C754943 Stefan Erb (ERS)
'History      : 03.08.2016 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
 
'------------------------------------
'--- Settings
'------------------------------------
'SQL-FORMATE:
    'Datumsformat
    'Oracle: TO_DATE('08/13/2017', 'MM/DD/YYYY')
    Private Const C_DATE_FORMAT = "TO_\DATE('MM\/DD\/YYYY', '\M\M\/\D\D\/\Y\Y\Y\Y')"
    Private Const C_DATE_TIMESTAMP = "sysdate"
 
    'MS Acceess: #08/13/2017'
    'Private Const C_DATE_FORMAT = "\#MM\/DD\/YYYY\#"
    'Private Const C_DATE_TIMESTAMP = "now"
 
    Private Const C_DATA_QUOTE = "'"
    Private Const C_DELEMITER = ", "
 
'Datentypen Kurzzeichen
    'Formate f�r den Formatrange
    'Standard, falls nichts angegeben wird: T_NUMBER
    Private Const T_STRING = "s"           'String      text -> 'text'
    Private Const T_DATE = "d"             'Datum       1.2.2016 -> TO_DATE('02/01/2016', 'MM/DD/YYYY')
    Private Const T_SUPRESS = "x"          'Spalte unterdr�cken
    Private Const T_DEFAULT = ""           'Wert unver�ndert zur�ckgeben
 
    Private Const A_NULL = "n"              'Standard:  NULL
    Private Const A_EMPTY = "e"             'Empty:     ''
    Private Const A_0 = "0"                 'Null:      0
    Private Const A_TIMESTAMP = "t"         '           SYSDATE
 
'------------------------------------
'--- Infos
'------------------------------------
 
' - Wenn die Spalte keinen Eintrag im HeaderRange hat, wird sie unterdr�ck
' - Spalten, welche im TypeRange 'x' drin haben, werden ebenfalls unterdr�ckt
' - Die Attribute zur Nullregelung k�nnen dem Type angeh�ngt werden
'   zB: sn -> Feld ist ein String, wenn kein Wert vorhanden ist wird der Text NULL ausgegeben
'       se -> Wieder ein String. Aber der Leerwert wird als '' ausgegeben
'       s  -> Wie sn
'       0  -> ohne formatierung. Ein Leerwertr wird als 0 ausgegeben
'       etc.
 
'------------------------------------
'--- Public Methodes
'------------------------------------
 
'/**
' * Setz ein einfaches Insert zusammen
' * @example    =joinSql("MY_TABLE"; A$9:Q$9; A11:Q11; A$10:Q$10)
' *
' * @param  Cell/String     Name der Zieltabelle
' * @param  Range           Range mit den Spaltennamen
' * @param  Range           Range mit den Daten (eine Zeile)
' * @param  Range           Range mit den Datentypzuweisung. Die Typenzuweisung ist typ & attribut.
' * @param  String          Datumsformat f�r den SQL-String
' * @return String
' */
Public Function joinSql( _
        ByVal iTableName As String, _
        ByRef iHeaderRange As Range, _
        ByRef iDataRange As Range, _
        Optional ByRef iTypeRange As Range _
) As String
    Dim cols() As String, values() As String, types() As String
    Dim size As Long, i As Long, k As Long, delta As Long
    Dim typ As String, attr As String
 
    'Anzahl Spalten ermitteln und arrays dimensionieren
    size = iHeaderRange.Cells.Count - 1
 
    'Spaltennamen ermitteln
    cols = range2array(iHeaderRange, size)
 
    'Falls ein Typenrange exisitiert, die Typen auslesen
    If Not IsMissing(iTypeRange) Then
        types = range2array(iTypeRange, size)
    Else
        ReDim types(size)
    End If
 
    'Daten auslesen
    values = range2array(iDataRange, size)
 
    'Daten formatieren
    For i = size To 0 Step -1
        splitType types(i), typ, attr
 
        'Falls kein Spaltennamen vorhanden ist, die Spalte unterdr�cken
        If cols(i) = Empty Then typ = T_SUPRESS
 
        'Leerer Wert abhandeln
        If values(i) = Empty And Not typ = T_SUPRESS Then
            typ = T_DEFAULT
            Select Case attr
                Case A_0:           values(i) = "0"
                Case A_EMPTY:       typ = T_STRING
                Case A_TIMESTAMP:   values(i) = C_DATE_TIMESTAMP
                Case Else:          values(i) = "NULL"
            End Select
        End If
 
        'Typ auswertwen
        Select Case typ
            Case T_STRING:          values(i) = C_DATA_QUOTE & values(i) & C_DATA_QUOTE
            Case T_DATE:            values(i) = Format(values(i), C_DATE_FORMAT)
            Case T_SUPRESS:
                delta = delta + 1
                'Alle Inhalte eins vorschieben
                For k = i To size - delta
                    cols(k) = cols(k + 1)
                    values(k) = values(k + 1)
                Next k
            Case Else:              'Ansonsten value unver�ndert stehen lassen
        End Select
    Next i
 
    'Leere Spalten am Ende, die durch supress entstanden sind, entfernen
    ReDim Preserve cols(size - delta)
    ReDim Preserve values(size - delta)
 
    joinSql = "insert into " & iTableName & " (" & join(cols, C_DELEMITER) & ") values (" & join(values, C_DELEMITER) & ");"
End Function
 
'/**
' * Gibt die Werte eines Ranges als Array zur�ck
' * @param  Range
' * @param  Long        Gr�sse des Arrays. Bei -1 wird der Array der Rangegr�sse angepasst
' * @return Array<String>
' */
Private Function range2array(ByRef iRange As Range, Optional ByVal iSize As Long = -1) As String()
    Dim i As Long
    Dim retArr() As String
 
    'Array auf Rangegr�sse definieren
    ReDim retArr(iRange.Count - 1)
    'Alle Elemente des Ranges in den Array abf�llen
    For i = 0 To iRange.Count - 1
        retArr(i) = iRange.item(i + 1).Text
    Next i
    'Auf gew�nschte Gr�sse k�rzen/verl�ngern
    ReDim Preserve retArr(IIf(iSize = -1, iRange.Count - 1, iSize))
 
    range2array = retArr
End Function
 
'/**
' * Teilt den Inhalt einer Typenzelle auf Typ und Attribut auf
' * @param  String  Type-String
' * @param  String  Out/ Typ
' * @param  String  Out/ Attribut
' * @return Boolean Typen-String konnte aufgeteilt werden
' */
Private Function splitType(ByVal iString As String, Optional ByRef oType As String, Optional ByRef oAttr As String) As Boolean
    '/^([sdx]?)([ne0t]?)$/i
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/^([" & T_DATE & T_DEFAULT & T_STRING & T_SUPRESS & "]?)([" & A_EMPTY & A_NULL & A_0 & A_TIMESTAMP & "]?)$/i")
    splitType = rx.test(iString)
    If splitType Then
        Dim m As Object: Set m = rx.execute(iString)(0)
        oType = m.subMatches(0)
        oAttr = m.subMatches(1)
    End If
End Function
 
 
'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * m�gliche Delemiter: @&!/~#=\|
' * m�gliche Modifiers: g (Global), i (IgnoreCode), m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function