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

Expand|Select|Wrap|Line Numbers

 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

import from excel using vb 6.0

re: import from excel using vb 6.0

Similar Visual Basic 4 / 5 / 6 bytes

/bytes/development

/bytes/it

/bytes/about