VISUAL BASIC

(Home)

'BeginAddNewVB



    'To integrate this code

    'replace the data source and initial catalog values

    'in the connection string



Public Sub Main()

    On Error GoTo ErrorHandler



    'recordset and connection variables

    Dim Cnxn As ADODB.Connection

    Dim rstEmployees As ADODB.Recordset

    Dim strCnxn As String

    Dim strSQL As String

     'record variables

    Dim strID As String

    Dim strFirstName As String

    Dim strLastName As String

    Dim blnRecordAdded As Boolean



    ' Open a connection

    Set Cnxn = New ADODB.Connection

    strCnxn = "Provider='sqloledb';Data Source='MySqlServer';" & _

        "Initial Catalog='Northwind';Integrated Security='SSPI';"

    Cnxn.Open strCnxn

       

    ' Open Employees Table with a cursor that allows updates

    Set rstEmployees = New ADODB.Recordset

    strSQL = "Employees"

    rstEmployees.Open strSQL, strCnxn, adOpenKeyset, adLockOptimistic, adCmdTable

    

    ' Get data from the user

    strFirstName = Trim(InputBox("Enter first name:"))

    strLastName = Trim(InputBox("Enter last name:"))

    

    ' Proceed only if the user actually entered something

    ' for both the first and last names

    If strFirstName <> "" And strLastName <> "" Then

    

        rstEmployees.AddNew

        rstEmployees!firstname = strFirstName

        rstEmployees!LastName = strLastName

        rstEmployees.Update

        blnRecordAdded = True

        

        ' Show the newly added data

        MsgBox "New record: " & rstEmployees!EmployeeId & " " & _

        rstEmployees!firstname & " " & rstEmployees!LastName

        

    Else

        MsgBox "Please enter a first name and last name."

    End If		

          

    ' Delete the new record because this is a demonstration

    Cnxn.Execute "DELETE FROM Employees WHERE EmployeeID = '" & strID & "'"

     

    ' clean up

    rstEmployees.Close

    Cnxn.Close

    Set rstEmployees = Nothing

    Set Cnxn = Nothing

    Exit Sub

    

ErrorHandler:

   ' clean up

    If Not rstEmployees Is Nothing Then

        If rstEmployees.State = adStateOpen Then rstEmployees.Close

    End If

    Set rstEmployees = Nothing

    

    If Not Cnxn Is Nothing Then

        If Cnxn.State = adStateOpen Then Cnxn.Close

    End If

    Set Cnxn = Nothing

    

    If Err <> 0 Then

        MsgBox Err.Source & "-->" & Err.Description, , "Error"

    End If

End Sub

'EndAddNewVB

dgv1.Columns.Add("Type", "Type")

dgv1.Columns.Add("Length", "Length")

For Each tbl1 In srv1.Databases.Item(dbsName).Tables()

If tbl1.SystemObject = False Then

If tbl1.Name = tblName Then

  For Each col1 In tbl1.Columns

     'pass paramArray

  Next

End If

End If

Next

Function dhFirstDayInWeek(Optional dtmDate As Date = 0) As Date

    ' Returns the first day in the week specified

    ' by the date in dtmDate.

    ' Uses localized settings for the first day of the week.

    If dtmDate = 0 Then

        ' Did the caller pass in a date? If not, use

        ' the current date.

        dtmDate = Date

    End If

    dhFirstDayInWeek = dtmDate - WeekDay(dtmDate, _

     vbUseSystem) + 1

End Function

Function dhLastDayInWeek(Optional dtmDate As Date = 0) As Date

    ' Returns the last day in the week specified by

    ' the date in dtmDate.

    ' Uses localized settings for the first day of the week.

    If dtmDate = 0 Then

        ' Did the caller pass in a date? If not, use

        ' the current date.

        dtmDate = Date

    End If

    dhLastDayInWeek = dtmDate - WeekDay(dtmDate, vbUseSystem) + 7

End Function