Untitled
unknown
plain_text
a year ago
9.8 kB
1
Indexable
Never
Private Sub ImportHerbalis()
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim xlAppOdg As Excel.Application
Dim wbOdg As Workbook
Dim wsOdg As Worksheet
Dim var As Variant
' Dim VarIDMoje As String
' Dim VarNazivMoje As String
' Dim VarKolicinaMoje As Single
Dim rs As Recordset
Dim RSBarCode As Recordset
Dim rsRobeNaIzlazu As Recordset
Dim rsKartica As Recordset
Dim S As String
Dim varRabatStopa As Double
Dim rsKPSKSS As Recordset
VarMojaAp = True
Dim VarSerija As String
CommonDialog1.Filter = "Excel 2003 (*.xls)|*.xls|Excel 2007-2010 (*.xlsx)|*.xlsx"
CommonDialog1.DefaultExt = "xls"
CommonDialog1.DialogTitle = "Select File"
CommonDialog1.ShowOpen
'The FileName property gives you the variable you need to use
If Trim(CommonDialog1.FileName) = "" Then
Exit Sub
End If
Open Replace(Replace(Trim(CommonDialog1.FileName), "xlsx", "txt"), "xls", "txt") For Output As #1
Set xlApp = New Excel.Application
' Set xlAppOdg = New Excel.Application
Set wb = xlApp.Workbooks.Open(CommonDialog1.FileName)
' Set wbOdg = xlAppOdg.Workbooks.Add
Set ws = wb.Worksheets(1) 'Specify your worksheet name
' Set wsOdg = wbOdg.Worksheets("Sheet1") 'Specify your worksheet name
'ws.Cells(1, 1) = "AAA"
Set rsRobeNaIzlazu = RobeDe.konRobe.Execute("Select * From RobenaUlazu where idUlaza='" & VarUlaz & "' and idrobe>0 order by id")
If rsRobeNaIzlazu.RecordCount = 0 Then
i = 2
j = 2
Else
i = 2
j = 2
k = 2
Do
rsRobeNaIzlazu.MoveLast
VarRoba = rsRobeNaIzlazu("IDRobe")
VarIDMoje = ws.Cells(k, 3).Value
Set RSBarCode = RobeDe.konRobe.Execute("Select ID From Robe Where prosifra='" & Trim(VarIDMoje) & "'")
If RSBarCode.RecordCount >= 1 Then
RSBarCode.MoveLast
If VarRoba = IIf(IsNull(RSBarCode("ID")), 0, RSBarCode("ID")) Then
i = k + 1
k = 10000
End If
End If
k = k + 1
Loop While ws.Cells(k, 1).Value <> ""
End If
CmdMoja.Enabled = False
Do
S = Str(ws.Cells(i, 1).Value)
'MsgBox VarBrojFakture & " " & S
If Trim(S) = Trim(VarBrojFakture) Then
VarIDMoje = ws.Cells(i, 3).Value
VarNazivMoje = Trim(ws.Cells(i, 4).Value)
VarKolicinaMoje = TextToNumber(ws.Cells(i, 5).Value)
Set RSBarCode = RobeDe.konRobe.Execute("Select ID From robe Where prosifra='" & Trim(VarIDMoje) & "'")
If RSBarCode.RecordCount >= 1 Then
RSBarCode.MoveLast
VarRoba = IIf(IsNull(RSBarCode("ID")), 0, RSBarCode("ID"))
Else
VarRoba = 0
Print #1, Trim(ws.Cells(i, 3).Value)
GoTo Preskoci
End If
On Error Resume Next
Dim RSmax As Recordset
Dim varMaximalni As Long
VarNovi = True
Set rs = RobeDe.konRobe.Execute("Select * From Ulazi where ID = '" & VarUlaz & "'")
varRabatStopa = IIf(IsNull(rs("RabatStopa")), 0, rs("RabatStopa"))
VarSerija = Trim(ws.Cells(i, 9))
RobeDe.konRobe.Execute ("Insert into RobeNaUlazu (IDUlaza, SifraVeleprodaje, BrojUlaza, DatumUlaza, VrstaUlaza, idrobe, kolicina, serijskibroj, datumisteka, fakturnacijena, fakturnacijenav, netofakturnacijena, netofakturnacijenav, nabavnacijena, veleprodajnacijena,karantin, automatskanivelacija) Values ('" & VarUlaz & "', '" & VarVeleprodaja & "', '" & VarBrojUlaza & "', '" & SqlDateFormat(VarDatumUlaza) & "', '" & VarVrstaUlaza & "', '" & VarRoba & "', '" & Str(VarKolicinaMoje) & "', '" & VarSerija & "', '" & SqlDateFormat(TextToDate(Trim(ws.Cells(i, 10)))) & "', '" & Str(TextToNumber(ws.Cells(i, 8).Value)) & "', '" & Str(TextToNumber(ws.Cells(i, 8).Value)) & "', '" & Str(TextToNumber(ws.Cells(i, 8).Value)) & "', '" & Str(TextToNumber(ws.Cells(i, 8).Value)) & "', '" & Str(TextToNumber(ws.Cells(i, 8).Value)) & "', '" & Str(TextToNumber(ws.Cells(i, 8).Value)) & "','1','0')")
' RobeDe.konRobe.Execute ("Update RobeNaUlazu set datumisteka = '" & SqlDateFormat(TextToDate(Trim(ws.Cells(i, 9)))) & "' where IDrobe = '" & VarRoba & "' and serijskibroj='" & VarSerija & "'")
' RobeDe.konRobe.Execute ("Update RobeNapovratud set datumisteka = '" & SqlDateFormat(TextToDate(Trim(ws.Cells(i, 10)))) & "' where IDrobe = '" & VarRoba & "' and serijskibroj='" & VarSerija & "'")
' RobeDe.konRobe.Execute ("Update RobeNapovratuk set datumisteka = '" & SqlDateFormat(TextToDate(Trim(ws.Cells(i, 10)))) & "' where IDrobe = '" & VarRoba & "' and serijskibroj='" & VarSerija & "'")
' RobeDe.konRobe.Execute ("Update Serijenaizlazu set datumisteka = '" & SqlDateFormat(TextToDate(Trim(ws.Cells(i, 10)))) & "' where IDrobe = '" & VarRoba & "' and serijskibroj='" & VarSerija & "'")
' RobeDe.konRobe.Execute ("Update serijeispravke set datumisteka = '" & SqlDateFormat(TextToDate(Trim(ws.Cells(i, 10)))) & "' where IDrobe = '" & VarRoba & "' and serijskibroj='" & VarSerija & "'")
Set rs = RobeDe.konRobe.Execute("Select id from RobeNaUlazu where idUlaza = '" & VarUlaz & "' Order by ID")
rs.MoveLast
VarRobaNaUlazu = rs("ID")
Set RSmax = RobeDe.konRobe.Execute("Select max(RedniBroj) as maximalni from robenaUlazu where IDUlaza = '" & VarUlaz & "'")
If IsNull(RSmax("maximalni")) = False Then
varMaximalni = RSmax("maximalni") + 1
Else
varMaximalni = 1
End If
Set rsKPSKSS = RobeDe.konRobe.Execute("Select Kontrola From RobeNaUlazu Where ltrim(rtrim(isnull(kontrola,'')))<>'' and IDRobe = '" & VarRoba & "' and ltrim(rtrim(isnull(Serijskibroj,'')))='" & Trim(VarSerija) & "' order by datumulaza")
If rsKPSKSS.RecordCount = 0 Then
Set rsKPSKSS = RobeDe.konRobe.Execute("Select Kontrola From robe2017.dbo.RobeNaUlazu Where ltrim(rtrim(isnull(kontrola,'')))<>'' and IDRobe = '" & VarRoba & "' and ltrim(rtrim(isnull(Serijskibroj,'')))='" & Trim(VarSerija) & "' order by datumulaza")
End If
If rsKPSKSS.RecordCount > 0 Then
rsKPSKSS.MoveLast
RobeDe.konRobe.Execute ("Update RobeNaUlazu set Kontrola = '" & Trim(IIf(IsNull(rsKPSKSS("kontrola")), "", rsKPSKSS("kontrola"))) & "' Where ID = '" & VarRobaNaUlazu & "'")
End If
RobeDe.konRobe.Execute ("Update RobeNaUlazu set rabatstopa='" & Str(varRabatStopa) & "' where ID = '" & VarRobaNaUlazu & "'")
RobeDe.konRobe.Execute ("Update RobeNaUlazu set rabatiznos=round(fakturnacijena*rabatstopa/100,4), rabatiznosv=round(fakturnacijena*rabatstopa/100,4) where ID = '" & VarRobaNaUlazu & "'")
RobeDe.konRobe.Execute ("Update RobeNaUlazu set netofakturnacijena=fakturnacijena-rabatiznos, netofakturnacijenav=fakturnacijena-rabatiznos, nabavnacijena=fakturnacijena-rabatiznos where ID = '" & VarRobaNaUlazu & "'")
RobeDe.konRobe.Execute ("Update RobeNaUlazu set datumisteka=null where IDUlaza = '" & VarUlaz & "' and datumisteka='" & SqlDateFormat(Date) & "'")
RobeDe.konRobe.Execute ("Update robe set neaktivan=0 where IDRobe='" & VarRoba & "'")
Set rsKartica = RobeDe.konRobe.Execute("Select * From Karticerobe where IDRobe='" & VarRoba & "' and sifraveleprodaje='" & VarVeleprodaja & "'")
If rsKartica.RecordCount = 1 Then
RobeDe.konRobe.Execute ("Update RobeNaUlazu set veleprodajnacijena='" & Str(IIf(IsNull(rsKartica("Veleprodajnacijena")), 0, rsKartica("Veleprodajnacijena"))) & "' where ID = '" & VarRobaNaUlazu & "'")
RobeDe.konRobe.Execute ("Update RobeNaUlazu set vpruciznos=veleprodajnacijena-nabavnacijena where ID = '" & VarRobaNaUlazu & "'")
RobeDe.konRobe.Execute ("Update RobeNaUlazu set vprucstopa=round(vpruciznos*100/nabavnacijena,2) where ID = '" & VarRobaNaUlazu & "' and isnull(nabavnacijena,0)<>0")
RobeDe.konRobe.Execute ("Update RobeNaUlazu set RedniBroj = '" & varMaximalni & "', ppptarifnibroj=11, pppstopa=17, pppiznos=veleprodajnacijena*0.17, maloprodajnacijena=veleprodajnacijena*1.17 where ID = '" & VarRobaNaUlazu & "'")
Else
RobeDe.konRobe.Execute ("Update RobeNaUlazu set RedniBroj = '" & varMaximalni & "', ppptarifnibroj=11, pppstopa=17, pppiznos=veleprodajnacijena*0.17, maloprodajnacijena=veleprodajnacijena*1.17 where ID = '" & VarRobaNaUlazu & "'")
End If
VarZatvoriFormu = False
For k = 1 To 1000
Next k
VarMojaOK = False
VarZatvoriFormu = False
'frmRobaNaUlazu.Show 1
Preskoci:
i = i + 1
For k = 1 To 1000
Next k
If VarMojaAp = False Then
i = 10000
End If
Else
i = i + 1
End If
Loop While ws.Cells(i, 1).Value <> ""
Close #1
' wbOdg.SaveAs (Replace(Trim(CommonDialog1.FileName), ".xls", "odg.xls"))
' wbOdg.Close
wb.Close
xlApp.Quit
' xlAppOdg.Quit
Set ws = Nothing
Set wb = Nothing
Set xlApp = Nothing
' Set wsOdg = Nothing
' Set wbOdg = Nothing
' Set xlAppOdg = Nothing
Call fillListaRobaNaUlazu
'listaRobaNaIzlazu.ListItems.Remove (listaRobaNaIzlazu.ListItems.Count)
VarMojaAp = False
End Sub