valpacino

Private Sub insert_Click()

    Dim cnx As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set cnx = New ADODB.Connection
    Set rst = New ADODB.Recordset
    Dim NomUtilisateur As String, MotDePasse As String, NomServeur As String, NomBaseDeDonnées As String
    NomUtilisateur = "intranet"
    MotDePasse = "intranet"
    NomServeur = "x71vyscsa0b"
    NomBaseDeDonnées = "INTRANET_ASSURANCE_RECETTE"


    cnx.ConnectionString = "UID=" & NomUtilisateur & ";PWD=" & MotDePasse & ";" & "DRIVER={SQL Server};Server=" & NomServeur & ";Database=" & NomBaseDeDonnées & ";"
    cnx.Open

    admin = False
    rst.Open "SELECT cp FROM admin", cnx
    While Not (rst.EOF Or admin = True)
        If (rst(0) = Environ$("UserName")) Then
            admin = True
        Else
            rst.MoveNext
        End If
    Wend
    rst.Close

    If (admin = False) Then
        MsgBox "Vous n'avez pas les droits d'insertion !"
        Exit Sub
    End If


    Range("C3").Select
    nomDemandeur = ActiveCell.Offset(0, 0).Value
    prenomDemandeur = ActiveCell.Offset(1, 0).Value
    cpDemandeur = ActiveCell.Offset(2, 0).Value
    telephoneDemandeur = ActiveCell.Offset(3, 0).Value

    Range("D3").Select
    nomChefEssai = ActiveCell.Offset(0, 0).Value
    prenomChefEssai = ActiveCell.Offset(1, 0).Value
    cpChefEssai = ActiveCell.Offset(2, 0).Value

    Range("E7").Select
    nomEssai = ActiveCell.Offset(0, 0).Value
    numeroRame = ActiveCell.Offset(1, 0).Value

    Range("F9").Select
    dateDebut = ActiveCell.Offset(0, 0).Value
    dateFin = ActiveCell.Offset(1, 0).Value

    Range("G11").Select
    numPrestation = ActiveCell.Offset(0, 0).Value
    motif = ActiveCell.Offset(1, 0).Value
    obs = ActiveCell.Offset(2, 0).Value

    Dim nomArray() As String
    Dim prenomArray() As String
    Dim entrepriseArray() As String
    Dim roleObsArray() As String

    Range("C17").Select
    Dim i As Integer
    i = 0

    While (ActiveCell.Offset(i, 0) <> "")
        i = i + 1
    Wend

    ReDim nomArray(i)
    ReDim prenomArray(i)
    ReDim entrepriseArray(i)
    ReDim roleObsArray(i)

    i = 0
    While (ActiveCell.Offset(i, 0) <> "")
        nomArray(i) = ActiveCell.Offset(i, 0)
        i = i + 1
    Wend

    i = 0
    Range("D17").Select
    While (ActiveCell.Offset(i, 0) <> "")
        prenomArray(i) = ActiveCell.Offset(i, 0)
        i = i + 1
    Wend

    i = 0
    Range("E17").Select
    While (ActiveCell.Offset(i, 0) <> "")
        entrepriseArray(i) = ActiveCell.Offset(i, 0)
        roleObsArray(i) = ActiveCell.Offset(i, 1)
        MsgBox roleObsArray(i)
        i = i + 1
    Wend

    Dim values As New Dictionary
    values("Demandeur") = nomDemandeur & "," & prenomDemandeur & "," & cpDemandeur & "," & telephoneDemandeur & ","
    values("ChefEssai") = nomChefEssai & "," & prenomChefEssai & "," & cpChefEssai & ","
    values("Infos") = nomEssai & "," & numeroRame & ","
    values("DatesDebutFin") = dateDebut & "," & dateFin & ","
    values("Presta") = numPrestation & "," & motif & "," & obs & ","
    values("Noms") = Join(nomArray, ",")
    values("Prenoms") = Join(prenomArray, ",")
    values("Entreprises") = Join(entrepriseArray, ",")
    values("RoleObs") = Join(roleObsArray, ",")

    Dim hReq As Object

    Dim strUrl As String
        strUrl = "http://x71vyscsa0b:8080/autorisation_1231/Modele/giveMeData.php?demandeur=" & values("Demandeur") & "&chefessai=" & values("ChefEssai") & "&infos=" & values("Infos") & "&datesDebutFin=" & values("DatesDebutFin") & "&presta=" & values("Presta") & "&noms=" & values("Noms") & "&prenoms=" & values("Prenoms") & "&entreprises=" & values("Entreprises") & "&roleObs=" & values("RoleObs")

    Set hReq = CreateObject("Microsoft.XMLHTTP")
        With hReq
            .Open "POST", strUrl, False
            .SetRequestHeader "Content-Type", "text/xml; charset=utf-8"
            .Send
        End With

    MsgBox "Données transmises avec succès !"
End Sub