By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,835 Members | 1,951 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,835 IT Pros & Developers. It's quick & easy.

import from excel using vb 6.0

P: 3
Hi....

Hi everybody, i have a code that i make in VBA and know I want to use this code in to VB6. But i don't know how to use that code in to VB 6.0
Please correct this code so i can use it in VB 6.0.

Code:
--- use in mainform -------
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Private Sub cmdImport_Click()
  5. On Error Resume Next
  6.    Dim strMsg As String
  7.    Dim strFile As String
  8.    strFile = Nz(Me.txtFile, "")
  9.    If Dir(strFile) <> "sales.xls" Then
  10.       strMsg = "You must enter a path for the file named Sales.xls"
  11.       MsgBox strMsg, vbExclamation, "Error"
  12.       Me.txtFile.SetFocus
  13.    Else
  14.       Me.lblMsg.Caption = "Import store records."
  15.       strMsg = "Do you want to import Sales records from file: " & vbCrLf & strFile
  16.       If MsgBox(strMsg, vbQuestion + vbYesNo, "Start Import") = vbYes Then
  17.          CurrentDb.Execute "DELETE FROM [sales_import]"
  18.          strMsg = ProcessFileImport(Me.txtFile, "sales_import")
  19.          MsgBox strMsg, vbInformation, "Finished"
  20.          Me.lblMsg.Caption = strMsg
  21.          DoCmd.OpenTable "sales_import"
  22.          DoCmd.MoveSize 100, 100, 9500, 6500
  23.       Else
  24.          Me.lblMsg.Caption = "Import Cancelled."
  25.       End If
  26.    End If
  27. End Sub
  28.  
  29. Private Sub Form_Load()
  30. On Error Resume Next
  31.    Me.txtFile = CurrentProject.Path & "\sales.xls"
  32. End Sub
  33.  
  34. --- use in a module -----
  35.  
  36. Option Compare Database
  37. Option Explicit
  38. Public Function ProcessFileImport(ByVal sFile As String, ByVal sTable As String) As String
  39.    On Error GoTo ProcessFileImport_Error
  40.    ' Excel object variables
  41.    Dim appExcel As Excel.Application
  42.    Dim wbk As Excel.Workbook
  43.    Dim wks As Excel.Worksheet
  44.    ' Access object variables
  45.    Dim dbs As DAO.Database
  46.    Dim rstRead As DAO.Recordset
  47.    Dim rstWrite As DAO.Recordset
  48.    Dim fld As DAO.Field
  49.    ' Declared variables
  50.    Dim bytWks As Byte
  51.    Dim bytMaxPages As Byte
  52.    Dim intStartRow As Integer
  53.    Dim strData As String
  54.    Dim intMaxRow As Integer
  55.    Dim strSQL As String
  56.    Dim strMsg As String
  57.    Dim intLastCol As Integer
  58.    Dim intRow As Integer
  59.    Dim intRec As Integer
  60.    Dim strCurrFld As String
  61.    Dim intCol As Integer
  62.    Dim intLen As Integer
  63.    Dim varValue As Variant
  64.    Dim lngErrs As Long
  65.  
  66.    Const cPassword As String = "xxx999"
  67.    DoCmd.Hourglass True
  68.  
  69.    ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
  70.    Set appExcel = Excel.Application
  71.    Set wbk = appExcel.Workbooks.Open(sFile)
  72.    Set dbs = CurrentDb
  73.    ' Optionally, you can protect / unprotect with a password
  74.    'wkb.Unprotect (cPassword)
  75.  
  76.    ' You could loop through sheets, but for this example, we'll just do one.
  77.    bytMaxPages = 1
  78.    ' Sometimes there is header info, so the "Start Row" isn't the first one.
  79.    ' Set this variable to the first row that contains actual data.
  80.    intStartRow = 2
  81.    PostMessage "Opening file: " & sFile
  82.  
  83.    For bytWks = 1 To bytMaxPages
  84.       ' Initialize variables on each pass
  85.       Set wks = Nothing
  86.       Set rstRead = Nothing
  87.       intRow = intStartRow
  88.       ' Load current worksheet.  Find used range to determine row count.
  89.       Set wks = appExcel.Worksheets(bytWks)
  90.  
  91.       ' Optionally, you can protect / unprotect with a password
  92.       'wks.Unprotect (cPassword)
  93.  
  94.       ' You need to figure out how many rows this sheet contains, so to know
  95.       ' how far down to read.  That value is saved in intMaxRow
  96.       strData = wks.UsedRange.Address
  97.       intMaxRow = CInt(Mid(strData, InStrRev(strData, "$")))
  98.       'intMaxRow = CInt(Mid(strData, LastInStr(strData, "$")))
  99.  
  100.       strData = ""
  101.      ' Go get the list of fields for this worksheet from the Field Map table
  102.       strSQL = "SELECT [AccessField], [OrdinalPosition] FROM ImportColumnSpecs " & _
  103.                "WHERE [ImportName]='" & sTable & "' ORDER BY [OrdinalPosition] ASC;"
  104.       Set rstRead = dbs.OpenRecordset(strSQL, dbOpenDynaset)  
  105.       ' If there is a mistake and no specification exists, then exit with message
  106.       If rstRead.BOF And rstRead.EOF Then
  107.          strMsg = "The import spec was not found.  Cannot continue."
  108.          MsgBox strMsg, vbExclamation, "Error"
  109.       Else
  110.          rstRead.MoveLast
  111.          rstRead.MoveFirst
  112.          intLastCol = rstRead.RecordCount
  113.          ' The name of the import and destination table should be the same for this
  114.          ' code to function correctly.
  115.          Set rstWrite = dbs.OpenRecordset(sTable, dbOpenDynaset)
  116.          Do Until intRow > intMaxRow
  117.             ' Check row to be sure it is not blank.  If so, skip the row
  118.             For intCol = 1 To intLastCol
  119.                strData = strData & Trim(Nz(wks.Cells(intRow, intCol), ""))
  120.             Next      
  121.             If strData = "" Then
  122.                intRow = intRow + 1
  123.             Else
  124.                intRec = intRec + 1
  125.                PostMessage "Processing record " & intRec & ".  {StoreID=" & wks.Cells(intRow, 1) & "}"
  126.                rstWrite.AddNew
  127.                Do Until rstRead.EOF
  128.                   ' Loop through the list of fields, processing them one at a time.
  129.                   ' Grab the field name to simplify code and improve performance.
  130.                   strCurrFld = Nz(rstRead!AccessField, "")
  131.                   intCol = rstRead!OrdinalPosition
  132.  
  133.                   If dbs.TableDefs(sTable).Fields(strCurrFld).Type = dbText Then
  134.                      intLen = dbs.TableDefs(sTable).Fields(strCurrFld).Size
  135.                      varValue = Left(Nz(wks.Cells(intRow, intCol), ""), intLen)
  136.                   Else
  137.                      varValue = wks.Cells(intRow, intCol)
  138.                   End If
  139.  
  140.                   ' The database schema requires that empty fields contain NULL, not
  141.                   ' the empty string.
  142.                   If varValue = "" Then varValue = Null
  143.  
  144.                   ' Handle date columns.  Sometimes Excel doesn't format them as dates
  145.                   If InStr(1, strCurrFld, "Date") > 0 Then
  146.                      If Not IsDate(varValue) Then
  147.                         If IsNumeric(varValue) Then
  148.                            On Error Resume Next
  149.                            varValue = CDate(varValue)
  150.                            If Err.Number <> 0 Then
  151.                               ' Can't figure out the date.  Set to null
  152.                               varValue = Null
  153.                               Err.Clear
  154.                            End If
  155.                            On Error GoTo ProcessFileImport_Error
  156.                         Else
  157.                            lngErrs = lngErrs + 1
  158.                            varValue = Null
  159.                         End If
  160.                      End If
  161.                      rstWrite.Fields(strCurrFld) = varValue
  162.                   Else
  163.                      ' If not a date field, then just write the value to the rst
  164.                      rstWrite.Fields(strCurrFld) = varValue
  165.                   End If
  166.  
  167.                   rstRead.MoveNext
  168.                Loop
  169.                If Not rstRead.BOF Then rstRead.MoveFirst
  170.  
  171.                rstWrite.Update
  172.  
  173.                ' Reset the variables for processing of the next record.
  174.                strData = ""
  175.                intRow = intRow + 1
  176.                'Debug.Print intRow
  177.             End If
  178.          Loop
  179.          Set wks = Nothing
  180.       End If
  181.    Next
  182.  
  183. Exit_Here:
  184.    ' Report results
  185.    strMsg = "Total of " & intRow & " records imported."
  186.    PostMessage strMsg
  187.    ProcessFileImport = strMsg
  188.    ' Cleanup all objects  (resume next on errors)
  189.  
  190.    On Error Resume Next
  191.    ' Optionally, you can protect / unprotect with a password
  192.    'wkb.Protect (cPassword)
  193.    'wks.Protect (cPassword)
  194.    Set wks = Nothing
  195.    wbk.Close True
  196.    Set wbk = Nothing
  197.    appExcel.Quit
  198.    Set appExcel = Nothing
  199.    Set rstRead = Nothing
  200.    Set rstWrite = Nothing
  201.    Set dbs = Nothing
  202.    DoCmd.Hourglass False
  203.    Exit Function
  204.  
  205. ProcessFileImport_Error:
  206.    MsgBox Err.Description, vbExclamation, "Error"
  207.    Resume Exit_Here
  208.  
  209. End Function
  210.  
  211. Private Sub PostMessage(ByVal sMsg As String)
  212. On Error Resume Next
  213.    If IsLoaded("frmMain") Then
  214.       Forms!frmMain!lblMsg.Caption = sMsg
  215.       Forms!frmMain.Repaint
  216.    End If
  217. End Sub
  218.  
  219. Public Function IsLoaded(ByVal sForm As String) As Boolean
  220. On Error Resume Next
  221.  
  222. '/////////////////////////////////////////////
  223. '
  224. ' Returns True if the specified form is open
  225. ' in Form view or Datasheet view.
  226. '
  227. '/////////////////////////////////////////////
  228.  
  229. Const conObjStateClosed = 0
  230. Const conDesignView = 0
  231.  
  232.     If SysCmd(acSysCmdGetObjectState, acForm, sForm) <> conObjStateClosed Then
  233.         If Forms(sForm).CurrentView <> conDesignView Then
  234.             IsLoaded = True
  235.         End If
  236.     End If
  237.  
  238. End Function
  239.  
  240. Public Function LastInStr(sText As String, sFind As String) As Integer
  241. On Error Resume Next
  242.  
  243. '//////////////////////////////////////////////////////////////////////////
  244. '
  245. ' This function finds the last instance of a character within
  246. ' a string of characters and returns an integer representing
  247. ' the final position of the desired character.
  248. '
  249. ' Typically, this function us used to find the final "\" in
  250. ' a file path string
  251. '
  252. '//////////////////////////////////////////////////////////////////////////
  253.  
  254. Dim intCurrVal As Integer
  255. Dim intLastPosition As Integer
  256.  
  257.     intCurrVal = InStr(sText, sFind)
  258.     Do Until intCurrVal = 0
  259.         intLastPosition = intCurrVal
  260.         intCurrVal = InStr(intLastPosition + 1, sText, sFind)
  261.     Loop
  262.     LastInStr = intLastPosition
  263.  
  264. End Function
thanx for reply me.
Feb 1 '07 #1
Share this Question
Share on Google+
1 Reply


100+
P: 1,646
Hi. Create a form in vb. Make sure the project has excel as a reference. Paste this code. Create the controls on the form with the same name as your code and run it. Let us know what errors come up
Feb 3 '07 #2

Post your reply

Sign in to post your reply or Sign up for a free account.