wiegerklijnstra
Gebruiker
- Lid geworden
- 12 feb 2013
- Berichten
- 28
Beste mensen,
Ik heb het volgende scriptje aangepast voor eigen toepassing. In de eerste kolom op A11 beginnend zet ik de primaire sleutel waarde. In de volgende kolommen komen de gegevens die gewijzigd dienen te worden. Zolang de bovenste cel een waarde bevat gaat het allemaal goed. Maar als er in de bovenste cel van zeg kolom B of C een 0 is of leeg dan worden de resterende waardes daaronder en daarna niet meer ingelezen. Wie kan mij helpen...
Sub UpdateMySQLDatabasePHP2()
' waarschuwing
Dim Title$, Msg$, Style, Response
Title = " Boek nieuwe artikelen van leverancier in."
Msg = "De pakbonnen voor nieuwe artikelen worden ingeboekt." _
& vbCrLf & vbCrLf & "Controleer de gegevens in de gele kolom op het scherm." _
& vbCrLf & vbCrLf & "Je gaat definitief inboeken." _
& vbCrLf & vbCrLf & "Je keert terug naar het scherm waar je vandaan kwam." _
& vbCrLf & vbCrLf & "Weet je het zeker?"
Style = vbYesNo + vbDefaultButton2
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then Exit Sub
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
User_ID = Range("AB3").Value ' Gebruikersnaam
Password = Range("AB4").Value ' Password
Server_Name = Range("AB1").Value ' IP nummer of servernaam
Database_Name = Range("AB2").Value ' Naam van de database
Tabellen = Range("AB5").Value ' Naam van de tabel
rad = 0
While Range("a10").Offset(rad, 0).Value <> tom
TextStrang = tom
kolumn = 0
While Range("A11").Offset(0, kolumn).Value <> tom
If kolumn = 0 Then TextStrang = TextStrang & Cells(10, 1) & " = '" & Cells(11 + rad, 1)
If kolumn <> 0 Then TextStrang = TextStrang & "', " & Cells(10, 1 + kolumn) & " = '" & Cells(11 + rad, 1 + kolumn)
kolumn = kolumn + 1
Wend
TextStrang = TextStrang & "'"
SQLStr = "UPDATE " & Tabellen & " SET " & TextStrang & "WHERE " & Cells(10, 1) & " = '" & Cells(11 + rad, 1) & "'"
Set Cn = New ADODB.Connection
Cn.Open "Driver={MySQL ODBC 5.2a Driver};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
Cn.Execute SQLStr
rad = rad + 1
Wend
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
Ik heb het volgende scriptje aangepast voor eigen toepassing. In de eerste kolom op A11 beginnend zet ik de primaire sleutel waarde. In de volgende kolommen komen de gegevens die gewijzigd dienen te worden. Zolang de bovenste cel een waarde bevat gaat het allemaal goed. Maar als er in de bovenste cel van zeg kolom B of C een 0 is of leeg dan worden de resterende waardes daaronder en daarna niet meer ingelezen. Wie kan mij helpen...
Sub UpdateMySQLDatabasePHP2()
' waarschuwing
Dim Title$, Msg$, Style, Response
Title = " Boek nieuwe artikelen van leverancier in."
Msg = "De pakbonnen voor nieuwe artikelen worden ingeboekt." _
& vbCrLf & vbCrLf & "Controleer de gegevens in de gele kolom op het scherm." _
& vbCrLf & vbCrLf & "Je gaat definitief inboeken." _
& vbCrLf & vbCrLf & "Je keert terug naar het scherm waar je vandaan kwam." _
& vbCrLf & vbCrLf & "Weet je het zeker?"
Style = vbYesNo + vbDefaultButton2
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then Exit Sub
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
User_ID = Range("AB3").Value ' Gebruikersnaam
Password = Range("AB4").Value ' Password
Server_Name = Range("AB1").Value ' IP nummer of servernaam
Database_Name = Range("AB2").Value ' Naam van de database
Tabellen = Range("AB5").Value ' Naam van de tabel
rad = 0
While Range("a10").Offset(rad, 0).Value <> tom
TextStrang = tom
kolumn = 0
While Range("A11").Offset(0, kolumn).Value <> tom
If kolumn = 0 Then TextStrang = TextStrang & Cells(10, 1) & " = '" & Cells(11 + rad, 1)
If kolumn <> 0 Then TextStrang = TextStrang & "', " & Cells(10, 1 + kolumn) & " = '" & Cells(11 + rad, 1 + kolumn)
kolumn = kolumn + 1
Wend
TextStrang = TextStrang & "'"
SQLStr = "UPDATE " & Tabellen & " SET " & TextStrang & "WHERE " & Cells(10, 1) & " = '" & Cells(11 + rad, 1) & "'"
Set Cn = New ADODB.Connection
Cn.Open "Driver={MySQL ODBC 5.2a Driver};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
Cn.Execute SQLStr
rad = rad + 1
Wend
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub