Untitled

mail@pastecode.io avatar
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