Es wird problematisch, da ADODB nicht über die Befehlreferenz von Excel verfügt. Daher die Möglichkeit z. B. SetColor, PageSetup u.s.w. fehlen. Datenzugriff ist jedoch möglich, aber ziemlich eingeschränkt.
Code: Alles auswählen
; example by Kiffi
;modified by eleowal
EnableExplicit
Declare DatenAendern(oRS, Feld.s, Wert.s)
Global Databasename.s = "C:\MeineDatei.xls"
XIncludeFile "adoconstants.pbi"
dhToggleExceptions(#True)
Procedure ADOX_Example_Create_New_Database_Append_Tables_And_Columns()
If FileSize(Databasename) > 0
If DeleteFile(Databasename) = 0
ProcedureReturn
EndIf
EndIf
Protected oCatalog.l
Protected oTable.l
Protected oColumn.l
Protected ConnectionString.s
; Create the required ADOX-Object
oCatalog = dhCreateObject("ADOX.Catalog")
If oCatalog = 0
MessageRequester("ADOX-Example", "Couldn't create ADOX.Catalog")
ProcedureReturn
EndIf
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Databasename + ";Extended Properties=Excel 8.0"
dhPutValue(oCatalog,".ActiveConnection = %T",@ConnectionString)
;die Methode Catalog.Create(....) funktioniert bei Excel nicht. Man muss zuerst mindestens
;eine Tabelle und mindestens eine Spalte anlegen.
; Create a new table
oTable = dhCreateObject("ADOX.Table")
If oTable = 0
MessageRequester("ADOX-Example", "Couldn't create table")
dhReleaseObject(oCatalog)
ProcedureReturn
EndIf
; give the table a name
dhPutValue(oTable, ".Name = %T", @"TestTable")
;
; ; Create an ID-Column with Autoincrement (das läuft nicht....)
oColumn = dhCreateObject("ADOX.Column")
dhPutValue(oColumn, ".ParentCatalog = %o", oCatalog)
dhPutValue(oColumn, ".Name = %T", @"ID")
dhPutValue(oColumn, ".Type = %d", #adInteger)
; dhPutValue(oColumn, ".Properties(%T) = %b", @"Autoincrement", #True)
;
; ; Append the new column to the table
dhCallMethod(oTable, ".Columns.Append(%o)", oColumn)
;
; ; Create and append some more Columns
dhCallMethod(oTable, ".Columns.Append(%T, %d)", @"IntegerField", #adInteger)
dhCallMethod(oTable, ".Columns.Append(%T, %d)", @"TextField", #adVarWChar)
dhCallMethod(oTable, ".Columns.Append(%T, %d)", @"MemoField", #adLongVarWChar)
;
; Append table to catalog
dhCallMethod(oCatalog, ".Tables.Append(%o)", oTable)
;andere Möglichkeit existiert auch und ist wesentlich schneller....
Protected sql.s = "CREATE TABLE test(id int, name char(30), vorname char(30));"
Protected oCN.l
Protected i.l
oCN = dhCreateObject("ADODB.Connection")
If oCN = 0
MessageRequester("ADOX-Example", "Couldn't create ADODB.Connection")
ProcedureReturn
EndIf
If Not dhCallMethod(oCN, ".Open(%T)", @ConnectionString)
dhCallMethod(oCN, ".Execute(%T)", @sql)
For i = 1 To 100
sql = "Insert into [test$](id, name, vorname) VALUES(" + Str(i) + ", 'Nachname " + Str(i) + "', 'Vorname " + Str(i)+ "');"
dhCallMethod(oCN, ".Execute(%T)", @sql)
Next
dhCallMethod(oCN,".Close")
EndIf
;
dhReleaseObject(oColumn)
dhReleaseObject(oTable)
dhReleaseObject(oCatalog)
dhReleaseObject(oCN)
MessageRequester("ADOX-Example", "Ready. Database successfully created.")
EndProcedure
Procedure ADO_Example_Open_Existing_Table_And_Fill_In_Some_Data()
Protected oCN.l ; Connection-Object
Protected ConnectionString.s
Protected SQL.s
Protected Counter.l
; Connection string.
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Databasename + ";Extended Properties=Excel 8.0"
; Create the required ADO-Connection-Object
oCN = dhCreateObject("ADODB.Connection")
If oCN = 0
MessageRequester("ADOX-Example", "Couldn't create ADODB.Connection")
ProcedureReturn
EndIf
; Open the connection.
If Not dhCallMethod(oCN, ".Open(%T)", @ConnectionString)
; Insert some records.
For Counter = 0 To 99
SQL = "Insert Into TestTable (IntegerField, TextField, MemoField) Values (" + Str(Counter) + ", 'Text" + Str(Counter) + "', 'Memo" + Str(Counter) + "')"
dhCallMethod(oCN, ".Execute(%T)", @SQL)
Next
; Close the connection.
dhCallMethod(oCN, ".Close")
MessageRequester("ADOX-Example", "Ready. Database successfully filled with sample-data.")
Else
MessageRequester("ADOX-Example", "Couldn't open the Connection")
EndIf
dhReleaseObject(oCN)
EndProcedure
Procedure ADO_Example_Open_Existing_Table_And_Read_Data()
Shared oRS.l ; Connection-Object
Protected oCN.l ; Connection-Object
Protected szResponse.l
Protected ConnectionString.s
Protected SQL.s
Protected EOF.l
; Connection string.
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Databasename + ";Extended Properties=Excel 8.0"
; Create the required ADO-Connection-Object
oCN = dhCreateObject("ADODB.Connection")
If oCN = 0
MessageRequester("ADO", "Couldn't create Connection-Object")
ProcedureReturn
EndIf
; Open the connection.
If Not dhCallMethod(oCN, ".Open(%T)", @ConnectionString)
; Retrieve some records.from Range A1:D10
SQL = "Select * from [TestTable$A1:D10]"
oRS = dhCreateObject("ADODB.Recordset")
If oRS = 0
MessageRequester("ADO", "Kann Recordset nicht erstellen")
ProcedureReturn
EndIf
dhPutValue(oRS,".ActiveConnection = %o",oCN)
dhPutValue(oRS,".LockType = %d", 2)
dhPutValue(oRS,".Source = %T", @SQL)
dhCallMethod(oRS,".Open")
;gehe zu Ende
dhCallMethod(oRS,".MoveLast")
;
;mann kann die Daten aendern...
DatenAendern(oRS, "MemoField", "Das ist die letzte Memo")
DatenAendern(oRS, "TextField","Das ist der letzter Datensatz")
;gehe zu DS 5
dhCallMethod(oRS,".MoveFirst")
dhCallMethod(oRS,".Move %d",5)
DatenAendern(oRS, "MemoField", "Das ist die Memo Nr. 5")
DatenAendern(oRS, "TextField","Das ist der Text Nr. 5")
;und wieder zum Anfang
dhCallMethod(oRS,".MoveFirst")
;
;mann kann die Daten aendern...
DatenAendern(oRS, "MemoField", "Noch einen Wert, den ich will....")
DatenAendern(oRS, "TextField","Hier ist mein Text...")
Repeat
dhGetValue("%b", @EOF, oRS, ".EOF")
If EOF
Break
EndIf
dhGetValue("%T", @szResponse, oRS, ".Fields(%T).Value", @"IntegerField")
If szResponse : Debug "IntegerField: " + PeekS(szResponse) : EndIf
dhFreeString(szResponse) : szResponse = 0
dhGetValue("%T", @szResponse, oRS, ".Fields(%T).Value", @"TextField")
If szResponse : Debug "TextField: " + PeekS(szResponse) : EndIf
dhFreeString(szResponse) : szResponse = 0
dhGetValue("%T", @szResponse, oRS, ".Fields(%T).Value", @"MemoField")
If szResponse : Debug "MemoField: " + PeekS(szResponse) : EndIf
dhFreeString(szResponse) : szResponse = 0
Debug "-------"
dhCallMethod(oRS, ".MoveNext")
ForEver
; Close and release the recordset.
dhCallMethod(oRS, ".Close")
dhReleaseObject(oRS)
; Close and release the connection.
dhCallMethod(oCN, ".Close")
dhReleaseObject(oCN)
EndIf
EndProcedure
Procedure DatenAendern(oRS, Feld.s, Wert.s)
dhPutValue(oRS,".Fields(%T).Value = %T",@Feld, @Wert)
dhCallMethod(oRS,".Update")
EndProcedure
ADOX_Example_Create_New_Database_Append_Tables_And_Columns()
ADO_Example_Open_Existing_Table_And_Fill_In_Some_Data()
ADO_Example_Open_Existing_Table_And_Read_Data()
End