Private Sub cmdUpdateStockSurvey_Click()
Dim SQL As String
Dim bolRetVal As Boolean
Dim lRow As Integer
Dim RST As ADODB.Recordset
Dim lSeqNo As Long
Dim lPriceListNo As String
Dim lDiscountType As Integer
Dim lArticleNo As String
Dim lAgreedPrice As String
Dim lDiscountI As String
Dim lDiscountII As String
Dim lCurrencyNo As String
Dim lStartDate As String
Dim lStopDate As String
Dim lDateValue As Date
'\\her deklareres variablene som skal leses inn
lPriceListNo = ActiveSheet.Range("B3")
If Not IsNumeric(lPriceListNo) Then
MsgBox "Prislistenummer i celle B3 er ikke gyldig!", vbCritical
Exit Sub
End If
If LogOnGlobal = False Then
Exit Sub
End If
'On Error GoTo Feil
lDiscountType = 10 'kode for prisliste
lSeqNo = GetLastNo("SeqNo", mCatalog, lPriceListNo) + 10000
'\\startdate
If IsDate(ActiveSheet.Range("B4")) Then
lDateValue = ActiveSheet.Range("B4")
lStartDate = Replace(Format(lDateValue, "mm.dd.yyyy"), ".", "/")
Else
MsgBox "Startdato i celle B4 er ikke gyldig!", vbCritical
Exit Sub
End If
'\\stopdate
If IsDate(ActiveSheet.Range("B5")) Then
lDateValue = ActiveSheet.Range("B5")
lStopDate = Replace(Format(lDateValue, "mm.dd.yyyy"), ".", "/")
Else
MsgBox "Stoppdato i celle B5 er ikke gyldig!", vbCritical
Exit Sub
End If
lRow = 9
lArticleNo = Replace(Replace(ActiveSheet.Cells(lRow, 1), " ", ""), "'", "''", , , vbTextCompare)
Do Until ActiveSheet.Cells(lRow, 1) = ""
Application.StatusBar = "Skriver rad: " & lRow & ", artikkel: " & lArticleNo
'Legger innhold i cellene inn i variabler
lArticleNo = Replace(Replace(ActiveSheet.Cells(lRow, 1), " ", ""), "'", "''", , , vbTextCompare)
If lArticleNo = "" Then
Exit Do
End If
lAgreedPrice = ActiveSheet.Cells(lRow, 3)
If Not IsNumeric(lAgreedPrice) Then
ActiveSheet.Cells(lRow, 7) = "Avtalt pris ikke gyldig"
GoTo Neste
End If
lCurrencyNo = ActiveSheet.Cells(lRow, 4)
If Not IsNumeric(lCurrencyNo) Then
ActiveSheet.Cells(lRow, 7) = "Valutanr. ikke gyldig"
GoTo Neste
End If
lDiscountI = ActiveSheet.Cells(lRow, 5)
If Not IsNumeric(lDiscountI) Then
ActiveSheet.Cells(lRow, 7) = "Rabatt1 ikke gyldig"
GoTo Neste
End If
lDiscountII = ActiveSheet.Cells(lRow, 6)
If Not IsNumeric(lDiscountII) Then
ActiveSheet.Cells(lRow, 7) = "Rabatt2 ikke gyldig"
GoTo Neste
End If
'\\Sjekker om det artikkel finnes i artikkelregisteret
SQL = "SELECT ArticleNo FROM " & mOwner & ".Article"
SQL = SQL & " WHERE ArticleNo = '" & lArticleNo & "'"
Set RST = New ADODB.Recordset
RST.Open SQL, mCON, adOpenKeyset, adLockOptimistic, adCmdText
If RST.EOF = False Then
SQL = "INSERT INTO " & mOwner & ".DiscountAgreementCustomer(SeqNo,PriceListNo ,DiscountType,ArticleNo,AgreedPrice,DiscountI,DiscountII,CurrencyNo,"
SQL = SQL & " StartDate , StopDate, Created, LastUpdate, LastUpdatedBy, CreatedBy"
SQL = SQL & ",BonusPercent,DiscountII,DiscountIII,CustomerNo,DiscountGrpArtNo,DiscountGrpCustNo,FromQuantity,GrossPrice,IntermediateGroupNo,LoanPrice,MainGroupNo,Markup1,SubGroupNo,ToQuantity,UnitTypeNo,ProjectNo,Priority,PriceLabeled)"
SQL = SQL & " VALUES(" & lSeqNo & "," & lPriceListNo & "," & lDiscountType & ",'" & lArticleNo & "'," & Replace(lAgreedPrice, ",", ".") & ","
SQL = SQL & Replace(lDiscountI, ",", ".") & "," & Replace(lDiscountII, ",", ".") & "," & Replace(lCurrencyNo, ",", ".") & ",'" & lStartDate & "','" & lStopDate & "',getdate(),getdate(),1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)"
Debug.Print SQL
mCON.Execute SQL
lSeqNo = lSeqNo + 10000
ActiveSheet.Cells(lRow, 7) = "OK"
Else
ActiveSheet.Cells(lRow, 7) = "Artikkelnr ikke gyldig"
End If
Neste:
lRow = lRow + 1
Application.StatusBar = "Behandler rad: " & lRow
Loop
MsgBox "Ferdig!" & vbLf & vbLf & "Kontroller Status-kollone ang. feil.", vbInformation
Application.StatusBar = False
Exit Sub
Feil:
MsgBox "Det er oppstått en feil!" & vbLf & vbLf & "Feilnr: " & Err.Number & vbLf & "Beskrivelse: " & Err.Description, vbCritical
End Sub
Private Function GetLastNo(iNextWhat As String, iDB As String, Optional iWHERE As String) As String
Dim SQL As String
Dim RST As ADODB.Recordset
Dim lNextID As String
Select Case iNextWhat
Case "UniqueNo"
SQL = "SELECT MAX(UniqueID) as LastID FROM " & iDB & "." & mOwner & ".DiscountAgreementCustomer"
Set RST = New ADODB.Recordset
RST.Open SQL, mCON, adOpenForwardOnly, adLockReadOnly, adCmdText
If RST.EOF = False Then
If Not IsNull(RST!LastID) Then
lNextID = Val(RST!LastID)
Else
lNextID = 0
End If
Else
lNextID = 0
End If
Case "SeqNo"
SQL = "SELECT MAX(SeqNo) as LastID FROM " & iDB & "." & mOwner & ".DiscountAgreementCustomer"
SQL = SQL & " WHERE PriceListNo = " & iWHERE
Set RST = New ADODB.Recordset
RST.Open SQL, mCON, adOpenForwardOnly, adLockReadOnly, adCmdText
If RST.EOF = False Then
If Not IsNull(RST!LastID) Then
lNextID = Val(RST!LastID)
Else
lNextID = 10000000
End If
Else
lNextID = 10000000
End If
End Select
GetLastNo = lNextID
End Function