|
| |
Fortgeschrittene Programmierung| Re: Formcode in ein Modul | |  | | Autor: Martin01 | | Datum: 14.04.03 15:25 |
| 'Modul
Option Explicit
Public Enum DriverTypeEnumeration
dtAccess97 = 0
dtAccess2000 = 1
dtOracle = 2
dtSQLServer = 3
End Enum
Public Function GetProvider(ByVal DType As DriverTypeEnumeration)
Select Case DType
Case dtAccess2000: GetProvider = "Microsoft.Jet.OLEDB.4.0"
Case dtAccess97: GetProvider = "Microsoft.Jet.OLEDB.3.51"
Case dtSQLServer: GetProvider = "SQLOLEDB.1"
Case dtOracle: GetProvider = "MSDAORA"
End Select
End Function
Public Function Endung(ByVal Datei As String) As String
Dim Z As Long
Z = InStrRev(Datei, ".")
If Z > 0 Then
Endung = Right$(Datei, Z)
End If
End Function
Public Function ExecuteSQL(ByVal SQL As String, ByVal Connection As ADODB.Connection) As ADODB.Recordset
On Error Resume Next
Dim cmd As New ADODB.Command
With cmd
.CommandType = adCmdText
.CommandText = SQL
Set .ActiveConnection = Connection
Set ExecuteSQL = .Execute
End With
End Function
Public Function Durchsuchen( _
ByRef cdopen As CommonDialog, _
ByRef FileName As String, _
ByRef dte As DriverTypeEnumeration) As Boolean
'Aufrufen:
'If Durchsuchen(Form1.CommonDialog1) Then
' cbbTyp.ListIndex = dte
' txtPfad.Text = FileName
' Else
' cbbTyp.ListIndex = -1
' txtPfad.Text = ""
'End If
On Error Resume Next
FileName = ""
Durchsuchen = False
With cdopen
.CancelError = True
.InitDir = App.Path
.ShowOpen
End With
If Err.Number Then ' = cdlCancel Then
Exit Function
End If
FileName = cdopen.FileName
If Len(FileName) = 0 Then
Exit Function
End If
Select Case LCase(Endung(FileName))
Case "mdb": dte = DriverTypeEnumeration.dtAccess2000
Case "MDB": dte = DriverTypeEnumeration.dtAccess2000
Case "sdb": dte = DriverTypeEnumeration.dtSQLServer
Case "ora": dte = DriverTypeEnumeration.dtOracle
Case Default: dte = DriverTypeEnumeration.dtAccess97
End Select
Durchsuchen = True
End Function
Public Function Speichern(ByVal Text As String) As Boolean
'Aufrufen:
' Speicheren("Text")
' Speicheren(txtsql.Text)
' If Speicheren("Text") Then ...
' If Speicheren(txtsql.Text) Then ...
On Error Resume Next
Dim Datei As String
Dim Pfad As String
Dim iFF As Integer
Speichern = False
Datei = InputBox("Geben Sie den Namen ein", "Speicher...")
If Len(Trim$(Datei)) = 0 Then
Exit Function
End If
Pfad = App.Path
If Right$(Pfad, 1) <> "\" Then
Pfad = Pfad & "\"
End If
iFF = FreeFile
Open Pfad & Datei For Output As iFF
Print #iFF, Text
Close #iFF
Speichern = Err.Number <> 0
End Function
Public Sub Ausführen( _
ByVal DateiPfad As String, _
ByVal SeverName As String, _
ByVal sqlBenutzer As String, _
ByVal sqlPasswort As String, _
ByVal sqlText As String, _
ByRef Form As Form, _
ByRef cbb As ComboBox, _
ByRef Flex As MSFlexGrid, _
byRef tbTabelle as ...)
'Aufrufen
'Ausführen(...)
On Error GoTo Ausführen_Catch
Dim Rs As New ADODB.Recordset
Dim Cn As New ADODB.Connection
Dim Fi As Field
Dim i As Long
Dim sMsg As String
Select Case cbbTyp.ListIndex
Case DriverTypeEnumeration.dtAccess97 ' 0 'access 97
With Cn
.CursorLocation = adUseClient
.Provider = "Microsoft.Jet.OLEDB.3.5"
.ConnectionString = "Data Source=" & DateiPfad
End With
Case DriverTypeEnumeration.dtAccess2000 ' 1 'access 2000
With Cn
.CursorLocation = adUseClient
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & DateiPfad
End With
Case DriverTypeEnumeration.dtOracle '2 'oracle
Case DriverTypeEnumeration.dtSQLServer '3 'sql-server
With Cn
.Provider = GetProvider(cbbTyp.ListIndex)
.ConnectionString = "Data Source=" & sqlServerName & ";" & _
"User Id=" & sqlBenutzer & ";" & _
"Password=" & sqlPasswort & ";"
End With
End Select
Cn.Open
Set Rs = ExecuteSQL(sqlText, Cn)
If IsNull(Rs) = False Then
Set Flex.DataSource = Rs
For Each Fi In Rs.Fields
tbTabelle.Buttons(1).ButtonMenus.Add , Fi.Name, Fi.Name
Next
Form.Show (vbModal)
End If
Ausführen_Finalize:
Cn.Close
Exit Sub
Ausführen_Catch:
With Cn
For i = 0 To .Errors.Count - 1
sMsg = sMsg & .Errors(i).Description & vbCrLf
Next i
.Errors.Clear
End With
MsgBox sMsg, vbCritical, "Datenbankfehler"
End Sub | |
 | 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 |
 |
|
sevISDN 1.0 
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Neu! sevCommand 4.0 
Professionelle Schaltflächen im modernen Design!
Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. Weitere Infos
|
| |
|
Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|
Sie sind aktuell nicht angemeldet.
