Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Access- VBA zu VBScript
Autor: Nexus01
Datum: 14.09.06 12:27
Hallöle, ich habe das selbe Problem, also eine Konvertierung eines VBA-Programms nach VBScript. Leider bin ich auch nicht so VB bewandert, ich hoffe ihr könnt mir ein paar Tipps geben. Zu Funktion des VBA-Codes: Es liest eine XML Datei aus und erzeugt aus ausgewählten XML-Infos Tabellen innerhalb einer Access Datenbank. DieTabellen sollen nun nicht mehr in einer Access-DB erzeugt werden, sondern in einer Oracle-DB-Umgebung. Für _ein paar Tipps_ wäre ich sehr dankbar -------------------------------------- Option Compare Database Private Sub Befehl1_Click() On Error GoTo Err_Befehl1_Click Screen.PreviousControl.SetFocus DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70 Exit_Befehl1_Click: Exit Sub Err_Befehl1_Click: MsgBox Err.Description Resume Exit_Befehl1_Click End Sub Private Sub Befehl2_Click() Dim strDateiname As String Dim curTableName As String Dim curColumnName As String Dim curSQLQuery As String Dim curSQLHeader As String Dim curSQLBody As String Dim objXMLDocument As New MSXML2.DOMDocument Dim objXMLDocumentElement As Object Dim tdfneu As DAO.TableDef Dim db As DAO.Database Dim i As Long Dim j As Long Dim k As Long Dim l As Long Dim n As Long Dim tempMaxAttrCount As Long Dim tempMaxAttr As Long Dim fieldWatch As Boolean Dim objXMLAttr As Object Dim cnn As ADODB.Connection Set db = DAO.OpenDatabase(CurrentDb.Name) strDateiname = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) strDateiname = strDateiname & "\" & Me!Dateiname.Value MsgBox strDateiname With objXMLDocument .async = False .preserveWhiteSpace = False .validateOnParse = True .resolveExternals = False End With If objXMLDocument.Load(strDateiname) = True Then Set objXMLDocumentElement = objXMLDocument.documentElement Debug.Print objXMLDocument.Text Set cnn = CurrentProject.Connection 'Die Spalten für die aktuelle Tabelle ermitteln. 'Dafür wird der Datensatz mit der höchsten Anzahl an Attributen ausgesucht tempMaxAttrCount = 0 tempMaxAttr = 0 For l = 0 To objXMLDocumentElement.childNodes.length - 1 Set objXMLProjekt = objXMLDocumentElement.childNodes.Item(l) If objXMLProjekt.Attributes.length > tempMaxAttrCount Then tempMaxAttrCount = objXMLProjekt.Attributes.length tempMaxAttr = l End If Next l Set objXMLProjekt = objXMLDocumentElement.childNodes.Item(tempMaxAttr) If Not objXMLProjekt Is Nothing Then curTableName = objXMLProjekt.nodeName Set tdfneu = db.CreateTableDef(curTableName) 'Tabelle mit Spalten versehen For j = 0 To objXMLProjekt.Attributes.length - 1 Set objXMLAttr = objXMLProjekt.Attributes.Item(j) tdfneu.Fields.Append tdfneu.CreateField(objXMLAttr.Name, dbText) Next j db.TableDefs.Append tdfneu 'Tabelle füllen curSQLHeader = "insert into " & curTableName & "(" curSQLBody = " values (" For i = 0 To objXMLDocumentElement.childNodes.length - 1 Set objXMLProjekt = objXMLDocumentElement.childNodes.Item(i) For k = 0 To objXMLProjekt.Attributes.length - 1 Set objXMLAttr = objXMLProjekt.Attributes.Item(k) fieldWatch = True For n = 0 To tdfneu.Fields.Count - 1 If objXMLAttr.Name = tdfneu.Fields(n).Name Then fieldWatch = False Exit For End If Next n If fieldWatch Then tdfneu.Fields.Append tdfneu.CreateField(objXMLAttr.Name, dbText) End If If k = objXMLProjekt.Attributes.length - 1 Then curSQLHeader = curSQLHeader & objXMLAttr.Name & ") " curSQLBody = curSQLBody & "'" & objXMLAttr.Value & "'" & ");" Else curSQLHeader = curSQLHeader & objXMLAttr.Name & ", " curSQLBody = curSQLBody & "'" & Replace(objXMLAttr.Value, "'", "''") & "'" & "," End If Next k curSQLQuery = curSQLHeader & curSQLBody cnn.Execute curSQLQuery curSQLHeader = "insert into " & curTableName & "(" curSQLBody = " values (" Next i MsgBox "Tabelle ist angelegt!!" Else MsgBox "Keine Elemente!" End If Else MsgBox objXMLDocument.parseError.reason End If Set cnn = Nothing db.Close Set objXMLDocument = Nothing Set objXMLDocumentElement = Nothing Set tdfneu = Nothing Set objXMLAttr = Nothing End Sub

Access- VBA zu VBScript	1.447	LH	21.08.06 14:42
Re: Access- VBA zu VBScript	853	Martoeng	21.08.06 17:30
Re: Access- VBA zu VBScript	767	LH	22.08.06 08:54
Re: Access- VBA zu VBScript	795	Martoeng	22.08.06 16:51
Re: Access- VBA zu VBScript	834	Nexus01	14.09.06 12:27

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen