Hi all,

I want to import Account details from excel . I already got the code for how to open excel sheet. I'm getting some errors when i try to click import.If anybody knows the code for read excel file , please help me.

Thanks

Deepika 

Hi all,

I got it .

Thanks

Deepika

Hello Deepika, how are u?

could u show me or send in my email how are you reading the excel file? Im having trouble when read some types of data...The excel is returning null but the field contains data..and i dont know what to do...lol..

coud u show me?

thanks!

Rafael

hi Rafel,

Hope u vl help this code....

'-------------------------------start----------------------

Sub btnImportContactClick(Sender)
dim objRS2
dim curContactId,curTestId
    On Error Resume Next
    ListBox1.Items.Add("Begin import contact....")

    Set objExcel = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
       On Error GoTo 0
      'Wscript.Echo "Excel application not found."
       ListBox1.Items.Add("Excel application not found.")
       Wscript.Quit
    End If

    On Error GoTo 0

    Set objSLXDB = New SLX_DB
    strExcelPath = txtQMRFile.Text
    ' Open specified spreadsheet and select the first worksheet.
    objExcel.WorkBooks.Open strExcelPath
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
    intRow = 2
    Do While objSheet.Cells(intRow, 2).Value <> ""
on error resume next
       strICA = GetActualICA(Trim(objSheet.Cells(intRow, 2).Value))
       'check if ICA exist in the account table
       Set objRS = objSLXDB.GetNewRecordset
       Set objRS2 = objSLXDB.GetNewRecordset
       objRS.Close
       strSQL = "SELECT * FROM ACCOUNT WHERE ACCOUNT = '" & strICA & "'"
       objRS.Open strSQL, objSLXDB.Connection
       If not (objRS.BOF OR objRS.EOF) Then   'If found in account table, then possible to add to contact table
          'unable to check for duplicates
          strSQL = "SELECT * FROM CONTACT "
          objRS2.Close
          objRS2.Open strSQL, objSLXDB.Connection
If not (objRS2.BOF OR objRS2.EOF) Then
             With objRS2
                   .AddNew
                    curContactId = Application.BasicFunctions.GetIDFor("CONTACT")
                   .Fields("CONTACTID").Value = curContactId
                   .Fields("ACCOUNTID").Value = "" & objRS.Fields("ACCOUNTID").Value
                   .Fields("ACCOUNT").Value = "" & objRS.Fields("ACCOUNT").Value
                   .Fields("CREATEUSER").Value = Application.BasicFunctions.CurrentUserID
                   .Fields("CREATEDATE").Value = Now()
                   .Fields("SALUTATION").Value = "" & objSheet.Cells(intRow, 3).Value
                   .Fields("TITLE").Value = "" & objSheet.Cells(intRow, 4).Value
                  ' .Fields("FUNCTION").Value = "" & objSheet.Cells(intRow, 5).Value
                  ' .Fields("DEAR").Value = "" & objSheet.Cells(intRow,6 ).Value
                  '.Fields("MAILING_COUNTRY").Value = "" & objSheet.Cells(intRow,11 ).Value
                  '.Fields("STATUS").Value = "" & objSheet.Cells(intRow,14 ).Value
                  '.Fields("PHONE").Value = "" & objSheet.Cells(intRow,14 ).Value
                 ' .Fields("PHONE_EXTN").Value = "" & objSheet.Cells(intRow,15 ).Value
                 .Fields("WORKPHONE").Value = "" & objSheet.Cells(intRow,15 ).Value
                  .Fields("MOBILE").Value = "" & objSheet.Cells(intRow,16 ).Value
                  '.Fields("PHONE_EXTN").Value = "" & objSheet.Cells(intRow,18 ).Value
                  '.Fields("MOBILE_CTRY").Value = "" & objSheet.Cells(intRow,19 ).Value
                  '.Fields("MOBILE_AREA_CODE").Value = "" & objSheet.Cells(intRow,20 ).Value
                  '.Fields("FAX").Value = "" & objSheet.Cells(intRow,22 ).Value
                  .Fields("EMAIL").Value = "" & objSheet.Cells(intRow,21 ).Value
                  '.Fields("OTHERS_PHONE#").Value = "" & objSheet.Cells(intRow,24 ).Value
                   .Fields("COMMENTS").Value = "" & objSheet.Cells(intRow,26 ).Value
                   .Fields("DECIDER").Value = "" & objSheet.Cells(intRow,27 ).Value
                   .Fields("ECONOMIC").Value = "" & objSheet.Cells(intRow,28 ).Value
                   .Fields("PRO").Value = "" & objSheet.Cells(intRow,29 ).Value
                   .Fields("PRESENTATION").Value = "" & objSheet.Cells(intRow,30 ).Value
                   .Fields("EXTERNALINFLUENCER").Value = "" & objSheet.Cells(intRow,31 ).Value
                   .Fields("INTERESTS").Value = "" & objSheet.Cells(intRow,32 ).Value
                   .Fields("EMBSTRENGTH").Value = "" & objSheet.Cells(intRow,33 ).Value
                   .Fields("SECCODEID").Value = "SYST00000001"
                    GetNames("" & objSheet.Cells(intRow, 1).Value)
                   .Fields("FIRSTNAME").Value = Application.GlobalInfo.FirstName
                   .Fields("MIDDLENAME").Value = Application.GlobalInfo.MiddleName
                   .Fields("LASTNAME").Value = Application.GlobalInfo.LastName
                   Application.GlobalInfo.Delete(Application.GlobalInfo.IndexOf("FirstName"))
                   Application.GlobalInfo.Delete(Application.GlobalInfo.IndexOf("MiddleName"))
                   Application.GlobalInfo.Delete(Application.GlobalInfo.IndexOf("LastName"))
                   .Fields("STATUS").Value = "" & objSheet.Cells(intRow, 14).Value
On Error GoTo 0
                  .Fields("ADDRESSID").Value = InsertNewContAddress(objSLXDB, objSheet, intRow, curContactId, objSheet.Cells(intRow, 6).Value)
                  .Update
                   .Close
                   ListBox1.Items.Add("Imported account with AccountName " & strICA)
              End With
          Else
              strMessage = "Unable to open contact table."
             ListBox1.Items.Add(strMessage)
           End If
      Else
           strMessage = "Account " & strICA & " not valid, does not exist TEST table."
           strMessage =  strICA & " not valid, does not exist account table."
          ListBox1.Items.Add(strMessage)
      End If
     intRow = intRow + 1
    Loop

    ' Close workbook and quit Excel.
    objExcel.ActiveWorkbook.Close
    objExcel.Application.Quit
    ListBox1.Items.Add("End import contact....")

    ' Clean up.
    Set objExcel = Nothing
    Set objSheet = Nothing
    Set objRS = Nothing
    Set objRS2 = Nothing
    set objSLXDB = Nothing
End Sub

'---------------------------end----------------------------

Thanks

Deepika

Deepika, or someone who knows, can tell me how can i do a piece of code if the program get an error? Example: i am testing this "read excel file" routine... But if the codes gives an error, the excel.exe remains in the memory..i want to do the codes to "clean" it... Someone knows how can i do this?

thanks!!

Rafael S.