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