import from excel using vb 6.0

[baling]

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 -------

Option Compare Database
Option Explicit
 
Private Sub cmdImport_Click()
On Error Resume Next
   Dim strMsg As String
   Dim strFile As String
   strFile = Nz(Me.txtFile, "")
   If Dir(strFile) <> "sales.xls" Then
      strMsg = "You must enter a path for the file named Sales.xls"
      MsgBox strMsg, vbExclamation, "Error"
      Me.txtFile.SetFocus
   Else
      Me.lblMsg.Caption = "Import store records."
      strMsg = "Do you want to import Sales records from file: " & vbCrLf & strFile
      If MsgBox(strMsg, vbQuestion + vbYesNo, "Start Import") = vbYes Then
         CurrentDb.Execute "DELETE FROM [sales_import]"
         strMsg = ProcessFileImport(Me.txtFile, "sales_import")
         MsgBox strMsg, vbInformation, "Finished"
         Me.lblMsg.Caption = strMsg
         DoCmd.OpenTable "sales_import"
         DoCmd.MoveSize 100, 100, 9500, 6500
      Else
         Me.lblMsg.Caption = "Import Cancelled."
      End If
   End If
End Sub
 
Private Sub Form_Load()
On Error Resume Next
   Me.txtFile = CurrentProject.Path & "\sales.xls"
End Sub
 
--- use in a module -----
 
Option Compare Database
Option Explicit
Public Function ProcessFileImport(ByVal sFile As String, ByVal sTable As String) As String
   On Error GoTo ProcessFileImport_Error
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   ' Access object variables
   Dim dbs As DAO.Database
   Dim rstRead As DAO.Recordset
   Dim rstWrite As DAO.Recordset
   Dim fld As DAO.Field
   ' Declared variables
   Dim bytWks As Byte
   Dim bytMaxPages As Byte
   Dim intStartRow As Integer
   Dim strData As String
   Dim intMaxRow As Integer
   Dim strSQL As String
   Dim strMsg As String
   Dim intLastCol As Integer
   Dim intRow As Integer
   Dim intRec As Integer
   Dim strCurrFld As String
   Dim intCol As Integer
   Dim intLen As Integer
   Dim varValue As Variant
   Dim lngErrs As Long
 
   Const cPassword As String = "xxx999"
   DoCmd.Hourglass True
 
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sFile)
   Set dbs = CurrentDb
   ' Optionally, you can protect / unprotect with a password
   'wkb.Unprotect (cPassword)
 
   ' You could loop through sheets, but for this example, we'll just do one.
   bytMaxPages = 1
   ' Sometimes there is header info, so the "Start Row" isn't the first one.
   ' Set this variable to the first row that contains actual data.
   intStartRow = 2
   PostMessage "Opening file: " & sFile
 
   For bytWks = 1 To bytMaxPages
      ' Initialize variables on each pass
      Set wks = Nothing
      Set rstRead = Nothing
      intRow = intStartRow
      ' Load current worksheet.  Find used range to determine row count.
      Set wks = appExcel.Worksheets(bytWks)
 
      ' Optionally, you can protect / unprotect with a password
      'wks.Unprotect (cPassword)
 
      ' You need to figure out how many rows this sheet contains, so to know
      ' how far down to read.  That value is saved in intMaxRow
      strData = wks.UsedRange.Address
      intMaxRow = CInt(Mid(strData, InStrRev(strData, "$")))
      'intMaxRow = CInt(Mid(strData, LastInStr(strData, "$")))
 
      strData = ""
     ' Go get the list of fields for this worksheet from the Field Map table
      strSQL = "SELECT [AccessField], [OrdinalPosition] FROM ImportColumnSpecs " & _
               "WHERE [ImportName]='" & sTable & "' ORDER BY [OrdinalPosition] ASC;"
      Set rstRead = dbs.OpenRecordset(strSQL, dbOpenDynaset)  
      ' If there is a mistake and no specification exists, then exit with message
      If rstRead.BOF And rstRead.EOF Then
         strMsg = "The import spec was not found.  Cannot continue."
         MsgBox strMsg, vbExclamation, "Error"
      Else
         rstRead.MoveLast
         rstRead.MoveFirst
         intLastCol = rstRead.RecordCount
         ' The name of the import and destination table should be the same for this
         ' code to function correctly.
         Set rstWrite = dbs.OpenRecordset(sTable, dbOpenDynaset)
         Do Until intRow > intMaxRow
            ' Check row to be sure it is not blank.  If so, skip the row
            For intCol = 1 To intLastCol
               strData = strData & Trim(Nz(wks.Cells(intRow, intCol), ""))
            Next      
            If strData = "" Then
               intRow = intRow + 1
            Else
               intRec = intRec + 1
               PostMessage "Processing record " & intRec & ".  {StoreID=" & wks.Cells(intRow, 1) & "}"
               rstWrite.AddNew
               Do Until rstRead.EOF
                  ' Loop through the list of fields, processing them one at a time.
                  ' Grab the field name to simplify code and improve performance.
                  strCurrFld = Nz(rstRead!AccessField, "")
                  intCol = rstRead!OrdinalPosition
 
                  If dbs.TableDefs(sTable).Fields(strCurrFld).Type = dbText Then
                     intLen = dbs.TableDefs(sTable).Fields(strCurrFld).Size
                     varValue = Left(Nz(wks.Cells(intRow, intCol), ""), intLen)
                  Else
                     varValue = wks.Cells(intRow, intCol)
                  End If
 
                  ' The database schema requires that empty fields contain NULL, not
                  ' the empty string.
                  If varValue = "" Then varValue = Null
 
                  ' Handle date columns.  Sometimes Excel doesn't format them as dates
                  If InStr(1, strCurrFld, "Date") > 0 Then
                     If Not IsDate(varValue) Then
                        If IsNumeric(varValue) Then
                           On Error Resume Next
                           varValue = CDate(varValue)
                           If Err.Number <> 0 Then
                              ' Can't figure out the date.  Set to null
                              varValue = Null
                              Err.Clear
                           End If
                           On Error GoTo ProcessFileImport_Error
                        Else
                           lngErrs = lngErrs + 1
                           varValue = Null
                        End If
                     End If
                     rstWrite.Fields(strCurrFld) = varValue
                  Else
                     ' If not a date field, then just write the value to the rst
                     rstWrite.Fields(strCurrFld) = varValue
                  End If
 
                  rstRead.MoveNext
               Loop
               If Not rstRead.BOF Then rstRead.MoveFirst
 
               rstWrite.Update
 
               ' Reset the variables for processing of the next record.
               strData = ""
               intRow = intRow + 1
               'Debug.Print intRow
            End If
         Loop
         Set wks = Nothing
      End If
   Next
 
Exit_Here:
   ' Report results
   strMsg = "Total of " & intRow & " records imported."
   PostMessage strMsg
   ProcessFileImport = strMsg
   ' Cleanup all objects  (resume next on errors)
 
   On Error Resume Next
   ' Optionally, you can protect / unprotect with a password
   'wkb.Protect (cPassword)
   'wks.Protect (cPassword)
   Set wks = Nothing
   wbk.Close True
   Set wbk = Nothing
   appExcel.Quit
   Set appExcel = Nothing
   Set rstRead = Nothing
   Set rstWrite = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
 
ProcessFileImport_Error:
   MsgBox Err.Description, vbExclamation, "Error"
   Resume Exit_Here
 
End Function
 
Private Sub PostMessage(ByVal sMsg As String)
On Error Resume Next
   If IsLoaded("frmMain") Then
      Forms!frmMain!lblMsg.Caption = sMsg
      Forms!frmMain.Repaint
   End If
End Sub
 
Public Function IsLoaded(ByVal sForm As String) As Boolean
On Error Resume Next
 
'/////////////////////////////////////////////
'
' Returns True if the specified form is open
' in Form view or Datasheet view.
'
'/////////////////////////////////////////////
 
Const conObjStateClosed = 0
Const conDesignView = 0
 
    If SysCmd(acSysCmdGetObjectState, acForm, sForm) <> conObjStateClosed Then
        If Forms(sForm).CurrentView <> conDesignView Then
            IsLoaded = True
        End If
    End If
 
End Function
 
Public Function LastInStr(sText As String, sFind As String) As Integer
On Error Resume Next
 
'//////////////////////////////////////////////////////////////////////////
'
' This function finds the last instance of a character within
' a string of characters and returns an integer representing
' the final position of the desired character.
'
' Typically, this function us used to find the final "\" in
' a file path string
'
'//////////////////////////////////////////////////////////////////////////
 
Dim intCurrVal As Integer
Dim intLastPosition As Integer
 
    intCurrVal = InStr(sText, sFind)
    Do Until intCurrVal = 0
        intLastPosition = intCurrVal
        intCurrVal = InStr(intLastPosition + 1, sText, sFind)
    Loop
    LastInStr = intLastPosition
 
End Function

thanx for reply me.

[willakawill]

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