Archiv der Kategorie: VBA

IBM DOORS, VBA

VBA (Import Excel in Doors): In Unicode Datei schreiben (TSV Datei erstellen) / Write to unicode file (create TSV file)

Schreibe einen Kommentar

Aufgabe – Problem

Der Inhalt eines Excel-Sheets mit Unicode soll in eine Datei geschrieben werden (damit z.B. IBM Doors über File -> Importieren -> Spreadsheet den Inhalt importieren kann).

A unicode file should be written with the contents of an Excel Sheet using VBA

Vorraussetzung – Prerequirement

Im VBA Editor muss im Menü unter „Verweise“ der Punkt „Microsoft Scripting Runtime“ aktiviert werden.
In the VBA Editor a reference should be added „Microsoft Scripting Runtime“

Ansatz – Approach

(Es wird VBA Code im Excel sheet hinterlegt was den Inhalt in eine TSV-Datei, die von Doors importiert werden kann, auslagert).
Das folgende Skript zeigt ein Iterieren über ein komplettes Excel sheet und schreibt die ersten 3 Spalten in Tabulator-Separiert in eine Datei. Somit könnte man eine TSV-Datei generieren die z.B. von IBM Doors eingelesen werden kann.

Lösung – Solution

    Dim letzteZeile As Integer
    Dim i As Integer
    
    Dim ID,Col1,Col2 As String
    
    Dim fso As New FileSystemObject

    ' Declare a TextStream.
    Dim stream As TextStream

    ' Create a TextStream.
    Set stream = fso.CreateTextFile("c:\dev\wingstext.csv", True, True)
      
    ' Finde die letzte Zeile
    letzteZeile = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
               
    For i = 1 To letzteZeile
        ID = Tabelle1.Cells(i, 1)
        Col1 = Tabelle1.Cells(i, 2)
        Col2 = Tabelle1.Cells(i, 3)
        
        stream.WriteLine ID & vbTab & Col1 & vbTab & Col2

    Next i
    
    ' Close the file.
    stream.Close
VBA

VBA: Einsatz und Ersatz für den trinären Operator ?:

Schreibe einen Kommentar

Aufgabenstellung

In Hochsprachen wie C#.NET und JAVA hilft der Einsatz vom trinären Operator oftmals, den Code leserlicher zu machen.

Ein Beispiel dafür ist das Zuweisen von Werten für ein Datenbankmodell bei einer Cursor-Iteration.

Wenn eine Materialnummer nicht vorhanden/leer ist, soll als String „not available“ angegeben werden:

Bsp. in C#

...
SqlDataReader reader = comm.ExecuteReader();
...
while (reader.Read())
{
   vo = new WorkflowPositionVO();
   vo.material = (reader.GetValue(0).ToString()=="")?
                       "not available":reader.GetValue(0).ToString();
...

Da der obige Code kompakt auf einer Zeile steht, und die gewünschte Funktionalität nicht durch 6-zeilige if/else-Konstrukte gewährleistet wird, führt dies bei vielen Attributen des Objektes „WorkflowPositionVO“ zu einer erhöhten Lesbarkeit des Codes. Man stelle sich 100 WorkflowPositionVO-Attribute vor, die zugewiesen werden müssen. Die Zahl von 600 (+100 Leerzeilen) würde auf 100 Zeilen reduziert werden, und die Fehleranfälligkeit dramatisch reduziert.

Problem

Der trinäre Operator ?: wird in VBA leider nicht unterstützt.

Ansatz

Die Funktionalität von ?: kann auf einen einfachen IF/ELSE-Zweig abgebildet werden, den man in eine Funktion auslagern könnte. Man könnte sich jetzt eine Funktion selbst implementieren, oder die fertige Funktion IIF benutzen. Hierbei handelt es sich um eine echte VBA-Funktion, die evtl. bereits durch ACCESS-Abfragen in SQL Statements bekannt ist.

Lösung

Bsp. in VBA:

   material = IIf(Tabelle.Cells(i,1)="","not available",Tabelle.Cells(i,1))
Programmierung, VBA

VBA: Dictionary / HashMap / assoziatives Array erstellen

Schreibe einen Kommentar

Aufgabenstellung

Wenn es nicht möglich ist, Werte nach einem fortlaufendem Index (Ordinalskala) zu klassifizieren, da keine wirklich logische Reihenfolge existiert, kann man auf assoziative Array/HashMaps oder Dictionaries (synonyme Bezeichnung für nominell skalierte Merkmale) zurückgreifen. Dies ist in der Regel aussagekräftiger als ein Index. Diese Datenstruktur bietet beim Zugriff auf ein Element eine sehr hohe Performance. Bei einem Index müßte man alle Elemente der Datenstruktur durchlaufen um einen geeigneten Schlüssel zu finden.

Ansatz

Da VBA nativ keine solche Datenstruktur besítzt, wird auf Microsoft Scripting Runtime Object Library (scrrun.dll) zugegriffen.

Vorraussetzungen

Die DLL Datei hierfür wird automatisch ab Office 2000 mitinstalliert. Im VBA Editor muss unter „Tools -> Verweise/References“ die Microsoft Scripting Runtime option angehakt werden.

Lösung

   Dim dictio As Object
   Dim dictioItem As Variant
    
   Set dictio = CreateObject("scripting.dictionary")
   dictio.Add "key1", "value1"
   dictio("key2") = "value2"
   dictio("key3") = "value3"

   MsgBox "-" & dictio("gibtsnich") & "-"
   Dim i As Integer
   i = 1
   For Each dictioItem In dictio
      If dictio(dictioItem) = "" Then Cells(i, 14).Value = "ich sagte das gibts nich"
      Cells(i, 12).Value = dictioItem
      Cells(i, 13).Value = dictio(dictioItem)
      i = i + 1
   Next
Access, Datenbanken, VBA

VBA und Access : Datenbankzugriff von VBA auf .mdb-Datei

Schreibe einen Kommentar

Aufgabenstellung

Von einer Office/VBA-Anwendung aus, soll auf eine Microsoft Access Datenbank (.mdb-Datei) zugegriffen werden.

Vorraussetzungen

Im VBA Editor im Menüpunkt Verweise wird die Option Microsoft ActiveX ADO Objects angehakt.

Lösung

Selektionsanweisung

Public Sub HoleDaten()
   Dim cn As New ADODB.Connection
   Dim rs As New ADODB.Recordset
   Dim i As Integer

' Datei liegt im aktuellen Projektverzeichnis
   cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & _
                 "\diedatei.mdb"

   Set rs = cn.Execute("SELECT * FROM einetabelle")

   i = 1
   Do While Not rs.EOF
      Cells(i, 1).Value = rs.Fields("Feld1")
      Cells(i, 2).Value = rs.Fields("Feld2")
      Cells(i, 3).Value = rs.Fields("Feld3")
      Cells(i, 4).Value = rs.Fields("Feld4")
      rs.MoveNext
      i = i + 1
   Loop
   cn.Close
End Sub

Manipulationsanweisung

Public Sub SchubseInMDB()
   Dim cn As New ADODB.Connection
   Dim rs As New ADODB.Recordset

   cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=unfug.mdb"

   Set rs = cn.Execute("INSERT INTO einetabelle(zweck)VALUES ('Unsinn')")
   cn.Close
End Sub
SAP, VBA

VBA und SAP: Funktionsbausteine aufrufen

Schreibe einen Kommentar

Aufgabenstellung

Die Aufgabenstellung sowie der Ansatz ist identisch mit diesem Artikel (Bitte zuerst lesen).

Prämissen / Vorraussetzungen

Die Datei librfc32.dll muss im VBA Editor eingebunden werden (sie ist nach der Installation der SAPGUI verfügbar).

Lösung

Aufbau der Verbindung

Public Function SAP_Logon(username As String, password As String) As Boolean
'*************************************************
'  ANMELDUNG AN SAP
'  ACHTUNG: USER MUSS BERECHTIGUNGEN HABEN!!!!
'*************************************************

    Set FunctionCtrl = CreateObject("SAP.Functions")
    'Objekt für die SAP Verbindung

    Set SapConnection = FunctionCtrl.Connection
   
    SapConnection.Client = "100"
    SapConnection.User = username
    SapConnection.Language = "DE"
    SapConnection.password = password
    
     SapConnection.hostname = "rechnername.firma.com" 'nicht das kuerzel wie DE9
    
    SapConnection.systemnumber = "0"

    If Not SapConnection.Logon(0, True) Then 'True silent - false offen
        MsgBox "Logon failed!!!", vbCritical
        CMS_Logon = False
    Else
        CMS_Logon = True
    End If
End Function

Abmelden

Public Function SAP_Logoff() As Boolean
    SapConnection.LogOff
End Function

Funktionbaustein befüllen und aufrufen

Public Function SAP_Create_Request() As Long
'******************************************************
'  Request erzeugen
'  Strukturen füllen und übergeben, dann Log ausgeben
'******************************************************

On Error GoTo ErrorMSG

    Dim FunctionModule As Object
    Dim e_EXPORTSTRUKTUR As Object
    Dim T_TABELLENSTRUKTUR As Object
    
    Dim te_messtab As Object
    
    Dim lCnt As Long

'   Assign Function Module
    Set FunctionModule = FunctionCtrl.Add("Z_FUBA")
    
'   Set export Variables
    Set e_EXPORTSTRUKTUR = FunctionModule.Exports("P_STRUKTURPARAMETER")

' Set structrue fields in export parameter
    e_EXPORTSTRUKTUR ("ZEXPORTPARAM1") = "BLA"
    e_EXPORTSTRUKTUR ("ZEXPORTPARAM1") = "BLA2"

    Set T_TABELLENSTRUKTUR  = FunctionModule.Tables("T_ZMMMATANF8")
    T_TABELLENSTRUKTUR.appendRow
    T_TABELLENSTRUKTUR(1, "SPALTE1") = 1
    T_TABELLENSTRUKTUR(1, "SPALTE2") = 2

    T_TABELLENSTRUKTUR.appendRow
    T_TABELLENSTRUKTUR(2, "SPALTE1") = 3
    T_TABELLENSTRUKTUR(2, "SPALTE2") = 4

'   Call Function Aufruf
    If FunctionModule.Call = True Then
        Set te_messtab = FunctionModule.Tables("TE_MESSTAB")
        ' Meldungen ausgeben:
        
        Dim intRow As Integer
        For intRow = 1 To te_messtab.RowCount
            If te_messtab(intRow, "ARBGB") = "ZMM0001" And _
                te_messtab(intRow, "MSGNR") = "003" Then

                ' ANForderung wurde erstellt.
                CMS_Create_Request = Val(te_messtab(intRow, "MSGV1"))
            End If
            Debug.Print te_messtab(intRow, "ARBGB")
            Debug.Print te_messtab(intRow, "MSGNR")
            Debug.Print te_messtab(intRow, "NATXT_DE")
            sMSGTXT = te_messtab(intRow, "NATXT_DE")
            Debug.Print te_messtab(intRow, "FLDNAME")
            Debug.Print te_messtab(intRow, "MSGV1")
            Debug.Print te_messtab(intRow, "MSGV2")
            Debug.Print te_messtab(intRow, "MSGV3")
            Debug.Print te_messtab(intRow, "MSGV4")
            Debug.Print "----------------------------------"
        Next
    Else
        CMS_Create_Request = 0
         MsgBox "Error creating the CMS Request." & vbNewLine & _
                "See Log for details", vbCritical
    End If
ErrorMSG:
  
End Function

Die Testfunktion

Public Sub Start()
'*************************************************
'  TESTUMGEBUNG
'*************************************************
    Dim RequestNo As Long
    Dim username As String
    Dim password As String
    
    username = "BJOERN"
    password = "ICHBINDERBESTE"
        
    Call CMS_Logon(username, password)
    RequestNo = SAP_Create_Request   
    Call CMS_Logoff
End Sub
VBA

Von Microsoft Excel in den Microsoft SQL Server importieren

2 Kommentare

Dies ist ein VBA Skript um Dateien von einer Excel-Tabelle in den Microsoft SQL Server zu importieren. Bevor das Skript läuft muss im VBA-Editor unter Extras -> Verweise „Microsoft ActiveX Data Objects“ als Bibliothek ausgewählt werden, damit ADODB.* zur Verfügung steht. 

Private Sub CommandButton1_Click()
    ' Die Datenbankverbindung
    Dim Cn As New ADODB.Connection
    Dim Rs As New ADODB.Recordset
    Dim letzteZeile As Integer
    Dim i As Integer
    
    ' Die beiden Felder material, prdha
    Dim materialnr As String
    Dim prdha As String
    
    ' Finde die letzte Zeile
    letzteZeile = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1
    
    ' Provider OLEDB Provider
    Cn.Provider = "SQLOLEDB.1"
    
    ' Connectionstring
    Cn.ConnectionString = "Password=meinpasswort;" & _
    "Persist Security Info=True;" & _
    "User ID=meinuser;" & _
    "Initial Catalog=meinedatenbank;" & _
    "Data Source=SERERNAMEODERIPADRESSE"
    
    ' Verbindung öffnen
    Cn.Open
            
    For i = 1 To letzteZeile
        materialnr = Tabelle1.Cells(i, 1)
        prdha = Tabelle1.Cells(i, 2)
        Cn.Execute ("INSERT INTO prdha(material, prdha) " & _
                         "VALUES('" + materialnr + "','" + prdha + "')")
    Next i
    
    ' Verbindung schließen
    Cn.Close
    
End Sub
VBA

Zugriff von VBA auf Microsoft SQL Server

Ein Kommentar

Zunächst wird (z.B. in Excel) im VBA-Editor im Menü „Verweise“ der Verweis „Microsoft ActiveX data Object“ hinzugefügt, damit man Zugriff auf die ADO-Klassen bekommt.

Private Sub CommandButton1_Click()
    Dim Cn As New ADODB.Connection
    Dim Rs As New ADODB.Recordset
    
    Cn.Provider = "SQLOLEDB.1"
    
    Cn.ConnectionString = "Password=daspasswort;" & _
    "Persist Security Info=True;" & _
    "User ID=deruser;" & _
    "Initial Catalog=datenbankname;" & _
    "Data Source=rechnername"
    
    Cn.Open
    
    Rs.CursorType = adOpenKeyset
    Rs.LockType = adLockPessimistic
    Rs.Open "SELECT TOP 10 * FROM globe2010juni_converted", Cn, adOpenStatic
   
    Do Until Rs.EOF
      Debug.Print Rs.Fields("compcode").Value
      Rs.MoveNext
    Loop
   
    Cn.Close
End Sub