home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / TextFile_I60696392002.psc / import.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-03-09  |  12.7 KB  |  383 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form Form1 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Text Import Wizard"
  6.    ClientHeight    =   5520
  7.    ClientLeft      =   45
  8.    ClientTop       =   435
  9.    ClientWidth     =   6000
  10.    Icon            =   "import.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   5520
  15.    ScaleWidth      =   6000
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.PictureBox Picture3 
  19.       Appearance      =   0  'Flat
  20.       BackColor       =   &H80000005&
  21.       BorderStyle     =   0  'None
  22.       ForeColor       =   &H80000008&
  23.       Height          =   6375
  24.       Left            =   0
  25.       Picture         =   "import.frx":0442
  26.       ScaleHeight     =   6375
  27.       ScaleWidth      =   6015
  28.       TabIndex        =   12
  29.       Top             =   0
  30.       Width           =   6015
  31.       Begin VB.ListBox List2 
  32.          Height          =   255
  33.          Left            =   600
  34.          TabIndex        =   14
  35.          Top             =   960
  36.          Visible         =   0   'False
  37.          Width           =   255
  38.       End
  39.       Begin VB.CommandButton Command5 
  40.          Caption         =   "Close Wizard"
  41.          Height          =   375
  42.          Left            =   4560
  43.          TabIndex        =   13
  44.          Top             =   4800
  45.          Width           =   1215
  46.       End
  47.       Begin MSComDlg.CommonDialog CommonDialog2 
  48.          Left            =   720
  49.          Top             =   3000
  50.          _ExtentX        =   847
  51.          _ExtentY        =   847
  52.          _Version        =   393216
  53.       End
  54.       Begin VB.Label Label6 
  55.          Alignment       =   2  'Center
  56.          BackColor       =   &H00FFFFFF&
  57.          Height          =   255
  58.          Left            =   2160
  59.          TabIndex        =   18
  60.          Top             =   2520
  61.          Width           =   3615
  62.       End
  63.       Begin VB.Label Label5 
  64.          Alignment       =   2  'Center
  65.          BackColor       =   &H00FFFFFF&
  66.          Height          =   255
  67.          Left            =   2160
  68.          TabIndex        =   17
  69.          Top             =   2040
  70.          Width           =   3615
  71.       End
  72.       Begin VB.Label Label4 
  73.          Alignment       =   2  'Center
  74.          BackColor       =   &H00FFFFFF&
  75.          Height          =   255
  76.          Left            =   2160
  77.          TabIndex        =   16
  78.          Top             =   1560
  79.          Width           =   3615
  80.       End
  81.       Begin VB.Label Label3 
  82.          Alignment       =   2  'Center
  83.          BackColor       =   &H00FFFFFF&
  84.          Caption         =   "Import succesfully!"
  85.          BeginProperty Font 
  86.             Name            =   "MS Sans Serif"
  87.             Size            =   12
  88.             Charset         =   0
  89.             Weight          =   700
  90.             Underline       =   0   'False
  91.             Italic          =   0   'False
  92.             Strikethrough   =   0   'False
  93.          EndProperty
  94.          Height          =   495
  95.          Left            =   2520
  96.          TabIndex        =   15
  97.          Top             =   360
  98.          Width           =   2895
  99.       End
  100.    End
  101.    Begin VB.PictureBox Picture2 
  102.       Appearance      =   0  'Flat
  103.       BackColor       =   &H80000005&
  104.       BorderStyle     =   0  'None
  105.       ForeColor       =   &H80000008&
  106.       Height          =   6375
  107.       Left            =   0
  108.       Picture         =   "import.frx":2968
  109.       ScaleHeight     =   6375
  110.       ScaleWidth      =   6015
  111.       TabIndex        =   3
  112.       Top             =   0
  113.       Width           =   6015
  114.       Begin VB.CommandButton Command2 
  115.          Caption         =   "Finish"
  116.          Height          =   375
  117.          Left            =   4560
  118.          TabIndex        =   9
  119.          Top             =   4800
  120.          Width           =   975
  121.       End
  122.       Begin VB.CommandButton Command3 
  123.          Caption         =   "< Back"
  124.          Height          =   375
  125.          Left            =   2280
  126.          TabIndex        =   8
  127.          Top             =   4800
  128.          Width           =   975
  129.       End
  130.       Begin VB.TextBox Text2 
  131.          Appearance      =   0  'Flat
  132.          Height          =   285
  133.          Left            =   3120
  134.          TabIndex        =   7
  135.          Top             =   2280
  136.          Width           =   2055
  137.       End
  138.       Begin VB.CommandButton Command4 
  139.          Caption         =   "...."
  140.          Height          =   255
  141.          Left            =   5400
  142.          TabIndex        =   6
  143.          Top             =   2280
  144.          Width           =   375
  145.       End
  146.       Begin VB.ComboBox Combo1 
  147.          Height          =   315
  148.          ItemData        =   "import.frx":4E8E
  149.          Left            =   3120
  150.          List            =   "import.frx":4EA1
  151.          Style           =   2  'Dropdown List
  152.          TabIndex        =   5
  153.          Top             =   2760
  154.          Width           =   2055
  155.       End
  156.       Begin VB.ListBox List1 
  157.          Height          =   255
  158.          Left            =   600
  159.          TabIndex        =   4
  160.          Top             =   960
  161.          Visible         =   0   'False
  162.          Width           =   255
  163.       End
  164.       Begin MSComDlg.CommonDialog CommonDialog1 
  165.          Left            =   720
  166.          Top             =   3000
  167.          _ExtentX        =   847
  168.          _ExtentY        =   847
  169.          _Version        =   393216
  170.       End
  171.       Begin VB.Label Label1 
  172.          BackColor       =   &H00FFFFFF&
  173.          Caption         =   "Choose file to import and choose a seperator"
  174.          Height          =   495
  175.          Left            =   2520
  176.          TabIndex        =   11
  177.          Top             =   360
  178.          Width           =   2895
  179.       End
  180.       Begin VB.Label Label2 
  181.          BackColor       =   &H00FFFFFF&
  182.          Caption         =   "File to Import :"
  183.          Height          =   255
  184.          Left            =   2160
  185.          TabIndex        =   10
  186.          Top             =   2280
  187.          Width           =   975
  188.       End
  189.    End
  190.    Begin VB.PictureBox Picture1 
  191.       Appearance      =   0  'Flat
  192.       BackColor       =   &H80000005&
  193.       BorderStyle     =   0  'None
  194.       ForeColor       =   &H80000008&
  195.       Height          =   6375
  196.       Left            =   0
  197.       Picture         =   "import.frx":4EB6
  198.       ScaleHeight     =   6375
  199.       ScaleWidth      =   6015
  200.       TabIndex        =   0
  201.       Top             =   0
  202.       Width           =   6015
  203.       Begin VB.CommandButton Command1 
  204.          Caption         =   "Next >"
  205.          Height          =   375
  206.          Left            =   4560
  207.          TabIndex        =   2
  208.          Top             =   4800
  209.          Width           =   975
  210.       End
  211.       Begin VB.TextBox Text1 
  212.          Appearance      =   0  'Flat
  213.          BorderStyle     =   0  'None
  214.          Height          =   1215
  215.          Left            =   2160
  216.          MultiLine       =   -1  'True
  217.          TabIndex        =   1
  218.          Text            =   "import.frx":73DC
  219.          Top             =   720
  220.          Width           =   3615
  221.       End
  222.    End
  223. Attribute VB_Name = "Form1"
  224. Attribute VB_GlobalNameSpace = False
  225. Attribute VB_Creatable = False
  226. Attribute VB_PredeclaredId = True
  227. Attribute VB_Exposed = False
  228. Private Sub Command1_Click()
  229. Picture1.Visible = False
  230. Picture2.Visible = True
  231. End Sub
  232. Function Does_Excist(TheFileName) As Boolean
  233. If Dir(TheFileName) <> "" Then Does_Excist = True Else Does_Excist = False
  234. End Function
  235. Private Sub Command2_Click()
  236. List1.Clear
  237. Dim seperator
  238. 'FIRST CHECK WHAT USER HAS CHOSEN
  239. If Combo1.Text = "Choose" Or Combo1.Text = "" Then
  240. MsgBox "Select a seperator used in the textfile", vbCritical, "Import error!"
  241. Exit Sub
  242. ElseIf Combo1.Text = "#" Then
  243. seperator = Chr$(35)
  244. ElseIf Combo1.Text = "*" Then
  245. seperator = Chr$(42)
  246. ElseIf Combo1.Text = "!" Then
  247. seperator = Chr$(33)
  248. ElseIf Combo1.Text = "^" Then
  249. seperator = Chr$(94)
  250. seperator = Chr$(9)
  251. End If
  252. Dim FileManually As String 'File to import
  253. FileManually = Text2.Text
  254. 'CHECK FOR EXCISTING FILENAME
  255. If Not Does_Excist(FileManually) Or FileManually = "" Then
  256. MsgBox "The file " & FileManually & " cannot be opened!", vbCritical, "Importfout!"
  257. Exit Sub
  258. On Error GoTo FileError
  259. Dim strline As String
  260. Dim strToSave
  261. Dim strToSave2
  262. Dim strToSave3
  263. Dim strToSave4
  264. Dim strToSave5
  265. Dim CountStrParts
  266. Dim CountStrParts2
  267. Dim CountStrParts3
  268. Dim CountStrParts4
  269. Dim CountStrParts5
  270. Dim CHARTOREPLACE
  271. CHARTOREPLACE = 0
  272. Dim x As Long 'Counter for number of records updated
  273. x = 0
  274. Dim y As Long 'Counter for number of records added new
  275. y = 0
  276. Set db = OpenDatabase(App.Path & "\" & "import.mdb")
  277. Set rs = db.OpenRecordset("Import", dbOpenTable)
  278.     Open FileManually For Input As #1
  279. Do Until EOF(1)
  280. Line Input #1, strline
  281. 'REPLACE A DOT FOR A COMMA
  282.     CHARTOREPLACE = InStr(strline, Chr$(46))
  283.         If CHARTOREPLACE > 0 Then Mid(strline, CHARTOREPLACE) = Chr$(44)
  284. Loop Until CHARTOREPLACE = 0
  285. 'END REPLACE
  286. 'HERE I BEGIN WITH CUTTING THE STRINT INTO 5 PARTS
  287. 'FIRST PART OF STRING
  288. CountStrParts = InStr(1, strline, seperator) 'Search for first seperator
  289. strToSave = Mid(strline, 1, CountStrParts - 1) 'Cut the string
  290. 'REMOVE SPACES
  291. strToSave = Trim(strToSave) 'THIS IS THE VARIABLE I WILL USE TO CHECK IF THE RECORD EXCISTS OR NOT
  292. 'END REMOVE SPACES
  293. 'END FIRST PART
  294. 'SECOND PART
  295. CountStrParts2 = InStr(CountStrParts + 1, strline, seperator) 'Search for second seperator
  296. strToSave2 = Mid(strline, CountStrParts + 1, CountStrParts2 - CountStrParts - 1) 'Cut the string
  297. 'REMOVE SPACES
  298. strToSave2 = Trim(strToSave2)
  299. 'END REMOVE SPACES
  300. 'END SECOUND PART
  301. 'THIRD PART
  302. CountStrParts3 = InStr(CountStrParts2 + 1, strline, seperator) 'Search for third seperator
  303. strToSave3 = Mid(strline, CountStrParts2 + 1, CountStrParts3 - CountStrParts2 - 1) 'Cut the string
  304. 'REMOVE SPACES
  305. strToSave3 = Trim(strToSave3)
  306. 'END REMOVE SPACES
  307. 'END THIRD PART
  308. 'FOURTH PART
  309. CountStrParts4 = InStr(CountStrParts3 + 1, strline, seperator) 'Search for fourth seperator
  310. strToSave4 = Mid(strline, CountStrParts3 + 1, CountStrParts4 - CountStrParts3 - 1) 'Cut the string
  311. 'REMOVE SPACES
  312. strToSave4 = Trim(strToSave4)
  313. 'END REMOVE SPACES
  314. 'END FOURTH PART
  315. 'FIFTH PART
  316. CountStrParts5 = Len(strline) 'Search for end of string
  317. strToSave5 = Mid(strline, CountStrParts4 + 1, CountStrParts5 - CountStrParts4) 'Cut the string
  318. 'REMOVE SPACES
  319. strToSave5 = Trim(strToSave5)
  320. 'END REMOVE SPACES
  321. 'END FIFTH PART
  322. 'IF EXCISTS THEN UPDATE RECORD, ELSE ADD NEW
  323. 'QUERY TO CHECK IF CODE EXCIST
  324. Dim mysql As String
  325. mysql = "SELECT Code, Product, Price, Totalprice, Description FROM Import WHERE Code = '" & strToSave & "'"
  326. Set rs2 = db.OpenRecordset(mysql)
  327. Do Until rs2.EOF
  328. List1.AddItem rs2.Fields!Code 'If code found add to listbox to get recordcount
  329. rs2.MoveNext
  330. If List1.ListCount = 0 Then  'Code doesnt excist, so add new
  331. rs.AddNew
  332. rs.Fields!Code = strToSave 'Save to field Code
  333. rs.Fields!Product = strToSave2 'Save to field Produkt
  334. rs.Fields!Price = strToSave3 'Save to field Inkoopprijs
  335. rs.Fields!Totalprice = strToSave4 'Save to field Verkoopprijs
  336. rs.Fields!Description = strToSave5 'Save to field Produktomschrijving
  337. rs.Update
  338. y = y + 1 'counter for number of records added new
  339. 'Else code does excist so update record
  340. Set rs2 = db.OpenRecordset(mysql)
  341. rs2.Edit
  342. rs2.Fields!Code = strToSave
  343. rs2.Fields!Product = strToSave2
  344. rs2.Fields!Price = strToSave3
  345. rs2.Fields!Totalprice = strToSave4
  346. rs2.Fields!Description = strToSave5
  347. rs2.Update
  348. x = x + 1 'Counter for number of records updated
  349. List1.Clear 'Clear listbox
  350. End If
  351. Loop 'LOOP TO NEXT IMPORTLINE
  352. 'END IMPORTING INTO DATABASE
  353. Dim xy As Long 'Number of records that have been added new/updated
  354. xy = x + y
  355. Picture3.Visible = True
  356. Picture2.Visible = False
  357. Label4.Caption = x & " records have been updated."
  358. Label5.Caption = y & " new records have been added."
  359. Label6.Caption = xy & " records have been checked."
  360. Close #1 'Close the importfile
  361. Exit Sub
  362. End If
  363. FileError:
  364. Close #1
  365. MsgBox "The importfile does not have the right format.", vbCritical, "Import error!"
  366. End Sub
  367. Private Sub Command4_Click()
  368.  CommonDialog1.DialogTitle = "Textfile to import"
  369.     CommonDialog1.Filter = "Textfiles(*.txt)|*.txt|"
  370. CommonDialog1.ShowOpen
  371.     Text2.Text = CommonDialog1.FileName
  372. End Sub
  373. Private Sub Command5_Click()
  374. End Sub
  375. Private Sub Command6_Click()
  376. Set db = OpenDatabase(App.Path & "\" & "import.mdb")
  377. End Sub
  378. Private Sub Form_Load()
  379. Picture1.Visible = True
  380. Picture2.Visible = False
  381. Picture3.Visible = False
  382. End Sub
  383.