Prikazi cijelu temu 10.02.2018 20:54
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: Iscitavajne iz CSV
Ovak kod ide u neki modul.
Pokrece se pozivom procedure importcsv a ulazni parametar je ime csv fajla.
Fajl se mora nalaziti u dir mdb baze.

PreuzmiIzvorni kôd (Visual Basic):
  1. Option Compare Database
  2. Option Explicit
  3. Function KreirajPolje(ImeTabele As String, ImePolja As String, TipPolja As Integer, _
  4. Optional Velicina As Integer, Optional Defolt)
  5. Dim Db As DAO.Database
  6. Dim tdf As DAO.TableDef
  7. Dim fld As DAO.Field
  8. '............................................
  9. 'Tip polja
  10. '1-jes/No
  11. '2-Number(Byte)
  12. '3-Number(Integer)
  13. '4-Number(Long Integer)
  14. '5-Currency
  15. '6-Number(Single)
  16. '7-Number(Double)
  17. '8-Date/Time
  18. '9-Binary
  19. '10-Text
  20. '11-OLE Object
  21. '12-Memo
  22. '.............................................
  23. Set Db = CurrentDb()
  24. Set tdf = Db.TableDefs(ImeTabele)
  25. Set fld = tdf.CreateField(ImePolja, TipPolja, Velicina)
  26. tdf.Fields.Append fld
  27.  
  28. Set tdf = Nothing
  29. Set fld = Nothing
  30. Set Db = Nothing
  31. End Function
  32. Function KreirajTabelu(ImeTabele As String)
  33.  
  34. Dim Db As DAO.Database
  35. Dim fld As DAO.Field
  36. Dim tdf As DAO.TableDef
  37.  
  38. Set Db = CurrentDb
  39. For Each tdf In Db.TableDefs
  40. If tdf.Name = ImeTabele Then
  41. DoCmd.DeleteObject acTable, ImeTabele
  42. End If
  43. Next tdf
  44.  
  45. Set Db = CurrentDb
  46. Set tdf = Db.CreateTableDef(ImeTabele)
  47. Set fld = tdf.CreateField("ID", dbLong)
  48. fld.Attributes = dbAutoIncrField
  49.     With tdf.Fields
  50.         .Append fld
  51.         .Refresh
  52.     End With
  53. Db.TableDefs.Append tdf
  54.     Set fld = Nothing
  55.     Set tdf = Nothing
  56.     Set Db = Nothing
  57. End Function
  58. Function ImportCSV(ImeCsv As String)
  59. Dim Db As DAO.Database
  60. Dim Rs0 As DAO.Recordset, Rs1 As DAO.Recordset
  61. Dim Putanja As String, SQL(1) As String, temp(1) As String, tmp(1) As String, ImePolja() As String
  62. Dim I As Integer, Poz(3) As Integer, Broj As Integer, BrojPolja As Integer
  63.  
  64.  
  65.  Set Db = CurrentDb
  66.  Putanja = Db_Putanja
  67.  KreirajTabelu "Prva"
  68.  KreirajPolje "Prva", "Red4", 3
  69.  KreirajPolje "Prva", "Red5", 3
  70.  KreirajTabelu "Druga"
  71.  SQL(0) = "SELECT * FROM Prva"
  72.  SQL(1) = "SELECT * FROM Druga"
  73.  Close #1
  74.  Open Putanja & ImeCsv For Input As 1
  75. While Not EOF(1)
  76.     If I = 5 Then
  77.     Set Rs1 = Db.OpenRecordset(SQL(1))
  78.     End If
  79.     Poz(1) = 1
  80.     Poz(0) = 1
  81.     Poz(2) = 1
  82.     Poz(3) = 1
  83.     BrojPolja = 0
  84.     I = I + 1
  85.    
  86.  Line Input #1, temp(0)
  87.  temp(0) = temp(0) & ";"
  88.  
  89.     If I = 4 Then
  90.      Set Rs0 = Db.OpenRecordset(SQL(0))
  91.      Line Input #1, temp(1)
  92.      temp(1) = temp(1) & ";"
  93.        Do While Len(temp(0)) <> Poz(1)
  94.        Poz(1) = InStr(Poz(0), temp(0), ";")
  95.        tmp(0) = Mid(temp(0), Poz(0), Poz(1) - Poz(0))
  96.        Poz(3) = InStr(Poz(2), temp(1), ";")
  97.        tmp(1) = Mid(temp(1), Poz(2), Poz(3) - Poz(2))
  98.             If tmp(0) <> "" Then
  99.             Broj = Val(tmp(0))
  100.                  If Broj > 0 Then
  101.                    Rs0.AddNew
  102.                    Rs0.Fields(1) = tmp(0)
  103.                    Rs0.Fields(2) = tmp(1)
  104.                    Rs0.Update
  105.                  End If
  106.             End If
  107.        Poz(0) = Poz(1) + 1
  108.        Poz(2) = Poz(3) + 1
  109.        Loop
  110.        Rs0.Close
  111.     ElseIf I = 5 Then
  112.         Do While Len(temp(0)) <> Poz(1)
  113.         Poz(1) = InStr(Poz(0), temp(0), ";")
  114.         tmp(0) = Mid(temp(0), Poz(0), Poz(1) - Poz(0))
  115.         BrojPolja = BrojPolja + 1
  116.         tmp(0) = tmp(0) & BrojPolja
  117.         ReDim Preserve ImePolja(BrojPolja)
  118.         ImePolja(BrojPolja) = tmp(0)
  119.         KreirajPolje "Druga", tmp(0), 10, 25
  120.         Poz(0) = Poz(1) + 1
  121.         Loop
  122.     ElseIf I > 5 Then
  123.         If Left(temp(0), 30) = String(30, ";") Then GoTo Kraj
  124.         Rs1.AddNew
  125.         Do While Len(temp(0)) <> Poz(1)
  126.         BrojPolja = BrojPolja + 1
  127.         Poz(1) = InStr(Poz(0), temp(0), ";")
  128.         tmp(0) = Mid(temp(0), Poz(0), Poz(1) - Poz(0))
  129.         If tmp(0) <> "" Then
  130.         Rs1(ImePolja(BrojPolja)) = tmp(0)
  131.         End If
  132.         Poz(0) = Poz(1) + 1
  133.         Loop
  134.         Rs1.Update
  135.     End If
  136.    
  137. Wend
  138. Kraj:
  139.  Rs1.Close
  140.  Set Db = Nothing
  141. End Function
  142.  
  143. Function Db_Putanja() As String
  144.  '--------------------------------------------------------------------------------------
  145. 'Ova funkcija pronalazi putanju postojee baze
  146. 'Autor funkcije ZXZ
  147. '__________________________________________________
  148.    Dim Db As Database, Putanja As String
  149.    
  150.     On Error Resume Next                                     'Ako naieÅ¡ na greÅ¡ku nastavi
  151.    Set Db = DBEngine(0)(0)                                  'Setovanje baze
  152.    Putanja = Db.Name                                          'Upis putanje baze i njenog imena
  153.    Do Until Right$(Putanja, 1) = "\"                         'Petlja za odvajanje imena baze od putanje baze
  154.        Putanja = Left$(Putanja, Len(Putanja) - 1)
  155.     Loop
  156.  
  157.     Db_Putanja = Putanja                                      'Upis putanje u funkciju
  158. End Function
  159.  
  160.                 Print #2, temp
  161.            End If
  162.          Else
  163.            Print #2, temp
  164.          End If
  165.     Else
  166.      Print #2, temp
  167.     End If
  168. Wend
  169.      Close #1
  170.      Close #2
  171. Set Db = Nothing
  172. End Function
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.